X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-array.lisp;h=9f677ef00ac84ef6e22d348c1070b3e675d34b45;hb=7dfa54273d2ebc6c2be9a39ab5cd6df639d340c9;hp=eeada76f1886c985112af5212e76ff03571421ce;hpb=b4831dc945c0754b3ba77881e67c8ea4d0a3d905;p=sbcl.git diff --git a/src/compiler/generic/vm-array.lisp b/src/compiler/generic/vm-array.lisp index eeada76..9f677ef 100644 --- a/src/compiler/generic/vm-array.lisp +++ b/src/compiler/generic/vm-array.lisp @@ -14,22 +14,24 @@ (in-package "SB!VM") (defstruct (specialized-array-element-type-properties - (:conc-name saetp-) - (:constructor - !make-saetp - (specifier - initial-element-default - n-bits - primitive-type-name - &key (n-pad-elements 0) complex-typecode (importance 0) - &aux (typecode - (eval (symbolicate primitive-type-name "-WIDETAG"))))) - (:copier nil)) + (:conc-name saetp-) + (:constructor + !make-saetp + (specifier + initial-element-default + n-bits + primitive-type-name + &key (n-pad-elements 0) complex-typecode (importance 0) fixnum-p + &aux (typecode + (symbol-value (symbolicate primitive-type-name "-WIDETAG"))))) + (:copier nil)) ;; the element specifier, e.g. BASE-CHAR or (UNSIGNED-BYTE 4) (specifier (missing-arg) :type type-specifier :read-only t) ;; the element type, e.g. # or ;; # (ctype nil :type (or ctype null)) + ;; true if the elements are tagged fixnums + (fixnum-p nil :type boolean :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) @@ -49,79 +51,133 @@ ;; 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 (missing-arg) :type index :read-only t) - ;; the relative importance of this array type. Used for determining - ;; the order of the TYPECASE in HAIRY-DATA-VECTOR-{REF,SET}. High - ;; positive numbers are near the top; low negative numbers near the - ;; bottom. + ;; the relative importance of this array type. Previously used for + ;; determining the order of the TYPECASE in + ;; HAIRY-DATA-VECTOR-{REF,SET}; currently (as of 2013-09-18) unused. (importance (missing-arg) :type fixnum :read-only t)) (defparameter *specialized-array-element-type-properties* (map 'simple-vector (lambda (args) - (apply #'!make-saetp args)) + (apply #'!make-saetp args)) `(;; Erm. Yeah. There aren't a lot of things that make sense - ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07 - (nil #:mu 0 simple-array-nil - :complex-typecode #.sb!vm:complex-vector-nil-widetag - :importance 0) - (base-char ,(code-char 0) 8 simple-base-string - ;; (SIMPLE-BASE-STRINGs are stored with an extra - ;; trailing #\NULL for convenience in calling out - ;; to C.) - :n-pad-elements 1 - :complex-typecode #.sb!vm:complex-base-string-widetag - :importance 17) - (single-float 0.0f0 32 simple-array-single-float - :importance 6) - (double-float 0.0d0 64 simple-array-double-float - :importance 5) - #!+long-float - (long-float 0.0l0 #!+x86 96 #!+sparc 128 simple-array-long-float - :importance 4) - (bit 0 1 simple-bit-vector - :complex-typecode #.sb!vm:complex-bit-vector-widetag - :importance 16) - ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come - ;; before their SIGNED-BYTE partners is significant in the - ;; implementation of the compiler; some of the cross-compiler - ;; code (see e.g. COERCE-TO-SMALLEST-ELTYPE in - ;; src/compiler/debug-dump.lisp) attempts to create an array - ;; specialized on (UNSIGNED-BYTE FOO), where FOO could be 7; - ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're - ;; not careful we could get the wrong specialized array when - ;; we try to FIND-IF, below. -- CSR, 2002-07-08 - ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2 - :importance 15) - ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4 - :importance 14) - ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8 - :importance 13) - ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16 - :importance 12) - ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32 - :importance 11) - ((signed-byte 8) 0 8 simple-array-signed-byte-8 - :importance 10) - ((signed-byte 16) 0 16 simple-array-signed-byte-16 - :importance 9) - ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX, - ;; compiler/generic/primtype.lisp, for why this is FIXNUM and - ;; not (SIGNED-BYTE 30) - (fixnum 0 32 simple-array-signed-byte-30 - :importance 8) - ((signed-byte 32) 0 32 simple-array-signed-byte-32 - :importance 7) - ((complex single-float) #C(0.0f0 0.0f0) 64 - simple-array-complex-single-float - :importance 3) - ((complex double-float) #C(0.0d0 0.0d0) 128 - simple-array-complex-double-float - :importance 2) - #!+long-float - ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256 - simple-array-complex-long-float - :importance 1) - (t 0 32 simple-vector :importance 18)))) + ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07 + (nil #:mu 0 simple-array-nil + :complex-typecode #.sb!vm:complex-vector-nil-widetag + :importance 0) + #!-sb-unicode + (character ,(code-char 0) 8 simple-base-string + ;; (SIMPLE-BASE-STRINGs are stored with an extra + ;; trailing #\NULL for convenience in calling out + ;; to C.) + :n-pad-elements 1 + :complex-typecode #.sb!vm:complex-base-string-widetag + :importance 17) + #!+sb-unicode + (base-char ,(code-char 0) 8 simple-base-string + ;; (SIMPLE-BASE-STRINGs are stored with an extra + ;; trailing #\NULL for convenience in calling out + ;; to C.) + :n-pad-elements 1 + :complex-typecode #.sb!vm:complex-base-string-widetag + :importance 17) + #!+sb-unicode + (character ,(code-char 0) 32 simple-character-string + :n-pad-elements 1 + :complex-typecode #.sb!vm:complex-character-string-widetag + :importance 17) + (single-float 0.0f0 32 simple-array-single-float + :importance 6) + (double-float 0.0d0 64 simple-array-double-float + :importance 5) + (bit 0 1 simple-bit-vector + :complex-typecode #.sb!vm:complex-bit-vector-widetag + :importance 16) + ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come + ;; before their SIGNED-BYTE partners is significant in the + ;; implementation of the compiler; some of the cross-compiler + ;; code (see e.g. COERCE-TO-SMALLEST-ELTYPE in + ;; src/compiler/debug-dump.lisp) attempts to create an array + ;; specialized on (UNSIGNED-BYTE FOO), where FOO could be 7; + ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're + ;; not careful we could get the wrong specialized array when + ;; we try to FIND-IF, below. -- CSR, 2002-07-08 + ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2 + :importance 15) + ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4 + :importance 14) + ((unsigned-byte 7) 0 8 simple-array-unsigned-byte-7 + :importance 13) + ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8 + :importance 13) + ((unsigned-byte 15) 0 16 simple-array-unsigned-byte-15 + :importance 12) + ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16 + :importance 12) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + ((unsigned-byte #.sb!vm:n-positive-fixnum-bits) + 0 32 simple-array-unsigned-fixnum + :importance 8 + :fixnum-p t) + ((unsigned-byte 31) 0 32 simple-array-unsigned-byte-31 + :importance 11) + ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32 + :importance 11) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((unsigned-byte #.sb!vm:n-positive-fixnum-bits) + 0 64 simple-array-unsigned-fixnum + :importance 8 + :fixnum-p t) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((unsigned-byte 63) 0 64 simple-array-unsigned-byte-63 + :importance 9) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((unsigned-byte 64) 0 64 simple-array-unsigned-byte-64 + :importance 9) + ((signed-byte 8) 0 8 simple-array-signed-byte-8 + :importance 10) + ((signed-byte 16) 0 16 simple-array-signed-byte-16 + :importance 9) + ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX, + ;; compiler/generic/primtype.lisp, for why this is FIXNUM and + ;; not (SIGNED-BYTE 30) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + (fixnum 0 32 simple-array-fixnum + :importance 8 + :fixnum-p t) + ((signed-byte 32) 0 32 simple-array-signed-byte-32 + :importance 7) + ;; KLUDGE: see above KLUDGE for the 32-bit case + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (fixnum 0 64 simple-array-fixnum + :importance 8 + :fixnum-p t) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((signed-byte 64) 0 64 simple-array-signed-byte-64 + :importance 7) + ((complex single-float) #C(0.0f0 0.0f0) 64 + simple-array-complex-single-float + :importance 3) + ((complex double-float) #C(0.0d0 0.0d0) 128 + simple-array-complex-double-float + :importance 2) + #!+long-float + ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256 + simple-array-complex-long-float + :importance 1) + (t 0 #.sb!vm:n-word-bits simple-vector :importance 18)))) + +(defun valid-bit-bash-saetp-p (saetp) + ;; BIT-BASHing isn't allowed on simple vectors that contain pointers + (and (not (eq t (sb!vm:saetp-specifier saetp))) + ;; Disallowing (VECTOR NIL) also means that we won't transform + ;; sequence functions into bit-bashing code and we let the + ;; generic sequence functions signal errors if necessary. + (not (zerop (sb!vm:saetp-n-bits saetp))) + ;; Due to limitations with the current BIT-BASHing code, we can't + ;; BIT-BASH reliably on arrays whose element types are larger + ;; than the word size. + (<= (sb!vm:saetp-n-bits saetp) sb!vm:n-word-bits))) (defvar sb!kernel::*specialized-array-element-types* (map 'list @@ -131,14 +187,39 @@ #-sb-xc-host (defun !vm-type-cold-init () (setf sb!kernel::*specialized-array-element-types* - '#.sb!kernel::*specialized-array-element-types*)) + '#.sb!kernel::*specialized-array-element-types*)) (defvar *simple-array-primitive-types* (map 'list (lambda (saetp) - (cons (saetp-specifier saetp) - (saetp-primitive-type-name saetp))) + (cons (saetp-specifier saetp) + (saetp-primitive-type-name saetp))) *specialized-array-element-type-properties*) #!+sb-doc "An alist for mapping simple array element types to their corresponding primitive types.") + +(defvar *vector-without-complex-typecode-infos* + #+sb-xc-host + (loop for saetp across *specialized-array-element-type-properties* + for specifier = (saetp-specifier saetp) + unless (saetp-complex-typecode saetp) + collect (list (if (atom specifier) + (intern (format nil "VECTOR-~A-P" specifier)) + ;; at the moment, all specialized array + ;; specifiers are either atoms or + ;; two-element lists. + (intern (format nil "VECTOR-~A-~A-P" (car specifier) (cadr specifier)))) + specifier)) + #-sb-xc-host + '#.*vector-without-complex-typecode-infos*) + +(in-package "SB!C") + +(defun find-saetp (element-type) + (find element-type sb!vm:*specialized-array-element-type-properties* + :key #'sb!vm:saetp-specifier :test #'equal)) + +(defun find-saetp-by-ctype (ctype) + (find ctype sb!vm:*specialized-array-element-type-properties* + :key #'sb!vm:saetp-ctype :test #'csubtypep))