X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=4b4337f813b9f9b50e200879559b71ccae4e5a54;hb=90ca09b75fbc3b63b2f7d09c67b04b866dd783f6;hp=1224c8508a50aaeebc2f785e9b33582a3df036c4;hpb=031ae238d37250e935dabaf2a3efb6e0305dd3e7;p=sbcl.git diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 1224c85..4b4337f 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -141,31 +141,27 @@ ;;; Convert VECTOR into a MAKE-ARRAY followed by SETFs of all the ;;; elements. -(def-source-transform vector (&rest elements) - (if (byte-compiling) - (values nil t) - (let ((len (length elements)) - (n -1)) - (once-only ((n-vec `(make-array ,len))) - `(progn - ,@(mapcar #'(lambda (el) - (once-only ((n-val el)) - `(locally (declare (optimize (safety 0))) - (setf (svref ,n-vec ,(incf n)) - ,n-val)))) - elements) - ,n-vec))))) +(define-source-transform vector (&rest elements) + (let ((len (length elements)) + (n -1)) + (once-only ((n-vec `(make-array ,len))) + `(progn + ,@(mapcar #'(lambda (el) + (once-only ((n-val el)) + `(locally (declare (optimize (safety 0))) + (setf (svref ,n-vec ,(incf n)) + ,n-val)))) + elements) + ,n-vec)))) ;;; Just convert it into a MAKE-ARRAY. -(def-source-transform make-string (length &key - (element-type ''base-char) - (initial-element - '#.*default-init-char-form*)) - (if (byte-compiling) - (values nil t) - `(make-array (the index ,length) - :element-type ,element-type - :initial-element ,initial-element))) +(define-source-transform make-string (length &key + (element-type ''base-char) + (initial-element + '#.*default-init-char-form*)) + `(make-array (the index ,length) + :element-type ,element-type + :initial-element ,initial-element)) (defstruct (specialized-array-element-type-properties (:conc-name saetp-) @@ -178,20 +174,20 @@ (:copier nil)) ;; the element type, e.g. # or ;; # - (ctype (required-argument) :type ctype :read-only t) + (ctype (missing-arg) :type ctype :read-only t) ;; what we get when the low-level vector-creation logic zeroes all ;; the bits (which also serves as the default value of MAKE-ARRAY's ;; :INITIAL-ELEMENT keyword) - (initial-element-default (required-argument) :read-only t) + (initial-element-default (missing-arg) :read-only t) ;; how many bits per element - (n-bits (required-argument) :type index :read-only t) + (n-bits (missing-arg) :type index :read-only t) ;; the low-level type code - (typecode (required-argument) :type index :read-only t) + (typecode (missing-arg) :type index :read-only t) ;; the number of extra elements we use at the end of the array for ;; low level hackery (e.g., one element for arrays of BASE-CHAR, ;; which is used for a fixed #\NULL so that when we call out to C ;; we don't need to cons a new copy) - (n-pad-elements (required-argument) :type index :read-only t)) + (n-pad-elements (missing-arg) :type index :read-only t)) (defparameter *specialized-array-element-type-properties* (map 'simple-vector @@ -199,32 +195,32 @@ (destructuring-bind (type-spec &rest rest) args (let ((ctype (specifier-type type-spec))) (apply #'!make-saetp ctype rest)))) - `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-type + `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag ;; (SIMPLE-STRINGs are stored with an extra trailing ;; #\NULL for convenience in calling out to C.) :n-pad-elements 1) - (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-type) - (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-type) + (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-widetag) + (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-widetag) #!+long-float (long-float 0.0L0 #!+x86 96 #!+sparc 128 - ,sb!vm:simple-array-long-float-type) - (bit 0 1 ,sb!vm:simple-bit-vector-type) - ((unsigned-byte 2) 0 2 ,sb!vm:simple-array-unsigned-byte-2-type) - ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-type) - ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-type) - ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-type) - ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-type) - ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-type) - ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-type) - ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-type) - ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-type) + ,sb!vm:simple-array-long-float-widetag) + (bit 0 1 ,sb!vm:simple-bit-vector-widetag) + ((unsigned-byte 2) 0 2 ,sb!vm:simple-array-unsigned-byte-2-widetag) + ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-widetag) + ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-widetag) + ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-widetag) + ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-widetag) + ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-widetag) + ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-widetag) + ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-widetag) + ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-widetag) ((complex single-float) #C(0.0s0 0.0s0) 64 - ,sb!vm:simple-array-complex-single-float-type) + ,sb!vm:simple-array-complex-single-float-widetag) ((complex double-float) #C(0.0d0 0.0d0) 128 - ,sb!vm:simple-array-complex-double-float-type) + ,sb!vm:simple-array-complex-double-float-widetag) #!+long-float ((complex long-float) #C(0.0L0 0.0L0) #!+x86 192 #!+sparc 256 - ,sb!vm:simple-array-complex-long-float-type) - (t 0 32 ,sb!vm:simple-vector-type)))) + ,sb!vm:simple-array-complex-long-float-widetag) + (t 0 32 ,sb!vm:simple-vector-widetag)))) ;;; The integer type restriction on the length ensures that it will be ;;; a vector. The lack of :ADJUSTABLE, :FILL-POINTER, and @@ -257,11 +253,11 @@ 'length `(+ length ,n-pad-elements))) (n-words-form - (if (>= n-bits-per-element sb!vm:word-bits) + (if (>= n-bits-per-element sb!vm:n-word-bits) `(* ,padded-length-form (the fixnum ; i.e., not RATIO - ,(/ n-bits-per-element sb!vm:word-bits))) - (let ((n-elements-per-word (/ sb!vm:word-bits + ,(/ n-bits-per-element sb!vm:n-word-bits))) + (let ((n-elements-per-word (/ sb!vm:n-word-bits n-bits-per-element))) (declare (type index n-elements-per-word)) ; i.e., not RATIO `(ceiling ,padded-length-form ,n-elements-per-word)))) @@ -331,7 +327,7 @@ (continuation-value element-type)) (t '*)) ,(make-list rank :initial-element '*)))) - `(let ((header (make-array-header sb!vm:simple-array-type ,rank))) + `(let ((header (make-array-header sb!vm:simple-array-widetag ,rank))) (setf (%array-fill-pointer header) ,total-size) (setf (%array-fill-pointer-p header) nil) (setf (%array-available-elements header) ,total-size) @@ -383,7 +379,7 @@ (give-up-ir1-transform "The array dimensions are unknown; must call ARRAY-DIMENSION at runtime.")) (unless (> (length dims) axis) - (abort-ir1-transform "The array has dimensions ~S, ~D is too large." + (abort-ir1-transform "The array has dimensions ~S, ~W is too large." dims axis)) (let ((dim (nth axis dims))) @@ -552,14 +548,14 @@ (cond (,end (unless (or ,unsafe? (<= ,end ,size)) ,(if fail-inline? - `(error "End ~D is greater than total size ~D." + `(error "End ~W is greater than total size ~W." ,end ,size) `(failed-%with-array-data ,array ,start ,end))) ,end) (t ,size)))) (unless (or ,unsafe? (<= ,start ,defaulted-end)) ,(if fail-inline? - `(error "Start ~D is greater than end ~D." ,start ,defaulted-end) + `(error "Start ~W is greater than end ~W." ,start ,defaulted-end) `(failed-%with-array-data ,array ,start ,end))) (do ((,data ,array (%array-data-vector ,data)) (,cumulative-offset 0 @@ -599,14 +595,10 @@ ;;; assertions on the array. (macrolet ((define-frob (reffer setter type) `(progn - (def-source-transform ,reffer (a &rest i) - (if (byte-compiling) - (values nil t) - `(aref (the ,',type ,a) ,@i))) - (def-source-transform ,setter (a &rest i) - (if (byte-compiling) - (values nil t) - `(%aset (the ,',type ,a) ,@i)))))) + (define-source-transform ,reffer (a &rest i) + `(aref (the ,',type ,a) ,@i)) + (define-source-transform ,setter (a &rest i) + `(%aset (the ,',type ,a) ,@i))))) (define-frob svref %svset simple-vector) (define-frob schar %scharset simple-string) (define-frob char %charset string)