X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=4b4337f813b9f9b50e200879559b71ccae4e5a54;hb=683874b497a99cd2c11b6c5d9b47e2785b1ede5f;hp=be3da293b3c5d5322ca2d444954e8fba72c2b6f2;hpb=dec94b039e8ec90baf21463df839a6181de606f6;p=sbcl.git diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index be3da29..4b4337f 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -141,7 +141,7 @@ ;;; Convert VECTOR into a MAKE-ARRAY followed by SETFs of all the ;;; elements. -(def-source-transform vector (&rest elements) +(define-source-transform vector (&rest elements) (let ((len (length elements)) (n -1)) (once-only ((n-vec `(make-array ,len))) @@ -155,10 +155,10 @@ ,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*)) +(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)) @@ -174,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 @@ -195,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 @@ -253,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)))) @@ -327,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) @@ -379,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))) @@ -548,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 @@ -595,9 +595,9 @@ ;;; assertions on the array. (macrolet ((define-frob (reffer setter type) `(progn - (def-source-transform ,reffer (a &rest i) + (define-source-transform ,reffer (a &rest i) `(aref (the ,',type ,a) ,@i)) - (def-source-transform ,setter (a &rest 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)