initial-element-default
n-bits
primitive-type-name
- &key (n-pad-elements 0) complex-typecode (importance 0)
+ &key (n-pad-elements 0) complex-typecode (importance 0) fixnum-p
&aux (typecode
(symbol-value (symbolicate primitive-type-name "-WIDETAG")))))
(:copier nil))
;; the element type, e.g. #<BUILT-IN-CLASS BASE-CHAR (sealed)> or
;; #<SB-KERNEL:NUMERIC-TYPE (UNSIGNED-BYTE 4)>
(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)
;; 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*
((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 29) 0 32 simple-array-unsigned-byte-29
- :importance 8)
+ ((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 60) 0 64 simple-array-unsigned-byte-60
- :importance 8)
+ ((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)
;; 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-signed-byte-30
- :importance 8)
+ (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-signed-byte-61
- :importance 8)
+ (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)
: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
#'saetp-specifier
"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))
projects / sbcl.git / blobdiff