mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-17 06:42:18 -08:00
Code Issues Projects Releases Packages Wiki Activity

An attempt at providing a unifor and simpler framework for optimizing array access.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-07-04 17:17:46 +02:00
parent 509166541b
commit 6446cde7c3
1 changed files with 90 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

90
src/cmp/cmpopt.lsp
View file

@ -311,3 +311,93 @@
(define-compiler-macro coerce (&whole form value type &environment env)
(expand-coerce form value type env))
;;;
;;; AREF/ASET
;;;
#|
(define-compiler-macro aref (&whole form array &rest indices &environment env)
(cond ((not (policy-open-code-aref/aset-p env))
form)
((null indices)
(list 'row-major-aref array 0))
((null (rest indices))
(cons 'row-major-aref (rest form)))
((rest indices)
(let* ((a (gensym))
(check (policy-array-bounds-check-p env))
(indices (expand-row-major-index a indices check)))
`(let ((,a ,array))
(declare (:read-only ,a))
(row-major-aref ,a ,indices))))))
(define-compiler-macro si::aset (&whole form value array &rest indices
&environment env)
(print (cmp-env-optimization 'safety env))
(print (cmp-env-optimization 'speed env))
(print (cmp-env-optimization 'debug env))
(cond ((not (policy-open-code-aref/aset-p env))
form)
((null indices)
(list 'si::row-major-aset array 0 value))
((null (rest indices))
(list 'si::row-major-aset array (first indices) value))
(t
(let* ((a (gensym))
(v (gensym))
(check (policy-array-bounds-check-p env))
(indices (expand-row-major-index a indices check)))
`(let ((,v ,value)
(,a ,array))
(declare (:read-only ,a ,v))
(si::row-major-aset ,a ,indices ,value))))))
(defmacro locally-unsafe (&rest forms)
`(locally (declare (optimize (safety 0))) ,@forms))
(defun expand-row-major-index (a indices &optional (check t))
(let* ((output-var (gensym))
(dim-var (gensym))
(ndx-var (gensym))
(expected-rank (length indices)))
`(let* ((,ndx-var ,(pop indices))
(,output-var ,ndx-var)
(,dim-var 0))
(declare (type si::index ,ndx-var ,output-var ,dim-var))
,@(when check
`((declare (optimize (safety 0)))
(unless (arrayp ,a)
(error-not-an-array ,a))
(unless (= (array-rank ,a) ,expected-rank)
(error-wrong-dimensions ,a ,expected-rank))
(setf ,dim-var (array-dimension ,a 0))
(unless (< ,output-var ,dim-var)
(error-wrong-index ,a ,ndx-var ,dim-var))))
,@(loop for j from 1
for index in indices
collect `(setf ,dim-var (array-dimension ,a ,j)
,ndx-var ,index)
collect (when check
`(unless (< ,ndx-var ,dim-var)
(error-wrong-index ,a ,ndx-var ,dim-var)))
collect `(setf ,output-var (the si::index
(+ (the si::index (* ,output-var ,dim-var))
,ndx-var))))
,output-var)))
(trace c::expand-row-major-index)
(defmacro error-not-an-array (a)
`(c-inline (,a) (:object) :void "FEtype_error_array(#0)"))
(defmacro error-wrong-dimensions (a rank)
`(c-inline (,a ,rank) (:object :cl-index) :void
"FEwrong_dimensions(#0,#1);"))
(defmacro error-wrong-index (a ndx limit)
`(c-inline (,a ,ndx ,limit) (:object :cl-index :cl-index) :void
"FEwrong_index(#0,#1,#2);"))
|#