X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=782368cceda1cca08811ec94176b8748a9e2cc9b;hb=31361af9eb64344f521abbb245ea784c76c746e5;hp=9b1a80f70fbc6f17d32b9d683d0aeeb5a0d59d17;hpb=95a6db7329b91dd90d165dd4057b9b5098d34aa2;p=sbcl.git diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 9b1a80f..782368c 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -11,14 +11,18 @@ (in-package "SB!C") -;;;; Derive-Type Optimizers - -;;; Array operations that use a specific number of indices implicitly assert -;;; that the array is of that rank. -(defun assert-array-rank (array rank) - (assert-continuation-type - array - (specifier-type `(array * ,(make-list rank :initial-element '*))))) +;;;; utilities for optimizing array operations + +;;; Return UPGRADED-ARRAY-ELEMENT-TYPE for CONTINUATION, or do +;;; GIVE-UP-IR1-TRANSFORM if the upgraded element type can't be +;;; determined. +(defun upgraded-element-type-specifier-or-give-up (continuation) + (let* ((element-ctype (extract-upgraded-element-type continuation)) + (element-type-specifier (type-specifier element-ctype))) + (if (eq element-type-specifier '*) + (give-up-ir1-transform + "upgraded array element type not known at compile time") + element-type-specifier))) ;;; Array access functions return an object from the array, hence its ;;; type will be asserted to be array element type. @@ -45,13 +49,22 @@ (assert-continuation-type new-value (array-type-element-type type)))) (continuation-type new-value)) -;;; Return true if Arg is NIL, or is a constant-continuation whose value is -;;; NIL, false otherwise. +;;; Return true if Arg is NIL, or is a constant-continuation whose +;;; value is NIL, false otherwise. (defun unsupplied-or-nil (arg) (declare (type (or continuation null) arg)) (or (not arg) (and (constant-continuation-p arg) (not (continuation-value arg))))) + +;;;; DERIVE-TYPE optimizers + +;;; Array operations that use a specific number of indices implicitly +;;; assert that the array is of that rank. +(defun assert-array-rank (array rank) + (assert-continuation-type + array + (specifier-type `(array * ,(make-list rank :initial-element '*))))) (defoptimizer (array-in-bounds-p derive-type) ((array &rest indices)) (assert-array-rank array (length indices)) @@ -79,8 +92,8 @@ (defoptimizer (hairy-data-vector-set derive-type) ((array index new-value)) (assert-new-value-type new-value array)) -;;; Figure out the type of the data vector if we know the argument element -;;; type. +;;; Figure out the type of the data vector if we know the argument +;;; element type. (defoptimizer (%with-array-data derive-type) ((array start end)) (let ((atype (continuation-type array))) (when (array-type-p atype) @@ -108,7 +121,7 @@ (unsupplied-or-nil fill-pointer)))) (specifier-type `(,(if simple 'simple-array 'array) - ,(cond ((not element-type) 't) + ,(cond ((not element-type) t) ((constant-continuation-p element-type) (continuation-value element-type)) (t @@ -423,13 +436,120 @@ :policy (and (> speed safety) (= safety 0))) 'index) -;;;; array accessors +;;;; WITH-ARRAY-DATA -;;; SVREF, %SVSET, SCHAR, %SCHARSET, CHAR, -;;; %CHARSET, SBIT, %SBITSET, BIT, %BITSET -;;; -- source transforms. +;;; This checks to see whether the array is simple and the start and +;;; end are in bounds. If so, it proceeds with those values. +;;; Otherwise, it calls %WITH-ARRAY-DATA. Note that %WITH-ARRAY-DATA +;;; may be further optimized. ;;; -;;; We convert all typed array accessors into aref and %aset with type +;;; Given any ARRAY, bind DATA-VAR to the array's data vector and +;;; START-VAR and END-VAR to the start and end of the designated +;;; portion of the data vector. SVALUE and EVALUE are any start and +;;; end specified to the original operation, and are factored into the +;;; bindings of START-VAR and END-VAR. OFFSET-VAR is the cumulative +;;; offset of all displacements encountered, and does not include +;;; SVALUE. +;;; +;;; When FORCE-INLINE is set, the underlying %WITH-ARRAY-DATA form is +;;; forced to be inline, overriding the ordinary judgment of the +;;; %WITH-ARRAY-DATA DEFTRANSFORMs. Ordinarily the DEFTRANSFORMs are +;;; fairly picky about their arguments, figuring that if you haven't +;;; bothered to get all your ducks in a row, you probably don't care +;;; that much about speed anyway! But in some cases it makes sense to +;;; do type testing inside %WITH-ARRAY-DATA instead of outside, and +;;; the DEFTRANSFORM can't tell that that's going on, so it can make +;;; sense to use FORCE-INLINE option in that case. +(def!macro with-array-data (((data-var array &key offset-var) + (start-var &optional (svalue 0)) + (end-var &optional (evalue nil)) + &key force-inline) + &body forms) + (once-only ((n-array array) + (n-svalue `(the index ,svalue)) + (n-evalue `(the (or index null) ,evalue))) + `(multiple-value-bind (,data-var + ,start-var + ,end-var + ,@(when offset-var `(,offset-var))) + (if (not (array-header-p ,n-array)) + (let ((,n-array ,n-array)) + (declare (type (simple-array * (*)) ,n-array)) + ,(once-only ((n-len `(length ,n-array)) + (n-end `(or ,n-evalue ,n-len))) + `(if (<= ,n-svalue ,n-end ,n-len) + ;; success + (values ,n-array ,n-svalue ,n-end 0) + ;; failure: Make a NOTINLINE call to + ;; %WITH-ARRAY-DATA with our bad data + ;; to cause the error to be signalled. + (locally + (declare (notinline %with-array-data)) + (%with-array-data ,n-array ,n-svalue ,n-evalue))))) + (,(if force-inline '%with-array-data-macro '%with-array-data) + ,n-array ,n-svalue ,n-evalue)) + ,@forms))) + +;;; This is the fundamental definition of %WITH-ARRAY-DATA, for use in +;;; DEFTRANSFORMs and DEFUNs. +(def!macro %with-array-data-macro (array + start + end + &key + (element-type '*) + unsafe? + fail-inline?) + (let ((size (gensym "SIZE-")) + (data (gensym "DATA-")) + (cumulative-offset (gensym "CUMULATIVE-OFFSET-"))) + `(let* ((,size (array-total-size ,array)) + (,end (cond (,end + (unless (or ,unsafe? (<= ,end ,size)) + ,(if fail-inline? + `(error "End ~D is greater than total size ~D." + ,end ,size) + `(failed-%with-array-data ,array ,start ,end))) + ,end) + (t ,size)))) + (unless (or ,unsafe? (<= ,start ,end)) + ,(if fail-inline? + `(error "Start ~D is greater than end ~D." ,start ,end) + `(failed-%with-array-data ,array ,start ,end))) + (do ((,data ,array (%array-data-vector ,data)) + (,cumulative-offset 0 + (+ ,cumulative-offset + (%array-displacement ,data)))) + ((not (array-header-p ,data)) + (values (the (simple-array ,element-type 1) ,data) + (the index (+ ,cumulative-offset ,start)) + (the index (+ ,cumulative-offset ,end)) + (the index ,cumulative-offset))) + (declare (type index ,cumulative-offset)))))) + +(deftransform %with-array-data ((array start end) + ;; Note: This transform is limited to + ;; VECTOR only because I happened to + ;; create it in order to get sequence + ;; function operations to be more + ;; efficient. It might very well be + ;; reasonable to allow general ARRAY + ;; here, I just haven't tried to + ;; understand the performance issues + ;; involved. -- WHN + (vector index (or index null)) + * + :important t + :node node + :policy (> speed space)) + "inline non-SIMPLE-vector-handling logic" + (let ((element-type (upgraded-element-type-specifier-or-give-up array))) + `(%with-array-data-macro array start end + :unsafe? ,(policy node (= safety 0)) + :element-type ,element-type))) + +;;;; array accessors + +;;; We convert all typed array accessors into AREF and %ASET with type ;;; assertions on the array. (macrolet ((define-frob (reffer setter type) `(progn