1 ;;;; this file centralizes information about the array types
2 ;;;; implemented by the system, where previously such information was
3 ;;;; spread over several files.
5 ;;;; This software is part of the SBCL system. See the README file for
8 ;;;; This software is derived from the CMU CL system, which was
9 ;;;; written at Carnegie Mellon University and released into the
10 ;;;; public domain. The software is in the public domain and is
11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
12 ;;;; files for more information.
16 (defstruct (specialized-array-element-type-properties
21 initial-element-default
24 &key (n-pad-elements 0) complex-typecode (importance 0) fixnum-p
26 (symbol-value (symbolicate primitive-type-name "-WIDETAG")))))
28 ;; the element specifier, e.g. BASE-CHAR or (UNSIGNED-BYTE 4)
29 (specifier (missing-arg) :type type-specifier :read-only t)
30 ;; the element type, e.g. #<BUILT-IN-CLASS BASE-CHAR (sealed)> or
31 ;; #<SB-KERNEL:NUMERIC-TYPE (UNSIGNED-BYTE 4)>
32 (ctype nil :type (or ctype null))
33 ;; true if the elements are tagged fixnums
34 (fixnum-p nil :type boolean :read-only t)
35 ;; what we get when the low-level vector-creation logic zeroes all
36 ;; the bits (which also serves as the default value of MAKE-ARRAY's
37 ;; :INITIAL-ELEMENT keyword)
38 (initial-element-default (missing-arg) :read-only t)
39 ;; how many bits per element
40 (n-bits (missing-arg) :type index :read-only t)
41 ;; the low-level type code (aka "widetag")
42 (typecode (missing-arg) :type index :read-only t)
43 ;; if an integer, a typecode corresponding to a complex vector
44 ;; specialized on this element type.
45 (complex-typecode nil :type (or index null) :read-only t)
46 ;; the name of the primitive type of data vectors specialized on
48 (primitive-type-name (missing-arg) :type symbol :read-only t)
49 ;; the number of extra elements we use at the end of the array for
50 ;; low level hackery (e.g., one element for arrays of BASE-CHAR,
51 ;; which is used for a fixed #\NULL so that when we call out to C
52 ;; we don't need to cons a new copy)
53 (n-pad-elements (missing-arg) :type index :read-only t)
54 ;; the relative importance of this array type. Used for determining
55 ;; the order of the TYPECASE in HAIRY-DATA-VECTOR-{REF,SET}. High
56 ;; positive numbers are near the top; low negative numbers near the
58 (importance (missing-arg) :type fixnum :read-only t))
60 (defparameter *specialized-array-element-type-properties*
63 (apply #'!make-saetp args))
64 `(;; Erm. Yeah. There aren't a lot of things that make sense
65 ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
66 (nil #:mu 0 simple-array-nil
67 :complex-typecode #.sb!vm:complex-vector-nil-widetag
70 (character ,(code-char 0) 8 simple-base-string
71 ;; (SIMPLE-BASE-STRINGs are stored with an extra
72 ;; trailing #\NULL for convenience in calling out
75 :complex-typecode #.sb!vm:complex-base-string-widetag
78 (base-char ,(code-char 0) 8 simple-base-string
79 ;; (SIMPLE-BASE-STRINGs are stored with an extra
80 ;; trailing #\NULL for convenience in calling out
83 :complex-typecode #.sb!vm:complex-base-string-widetag
86 (character ,(code-char 0) 32 simple-character-string
88 :complex-typecode #.sb!vm:complex-character-string-widetag
90 (single-float 0.0f0 32 simple-array-single-float
92 (double-float 0.0d0 64 simple-array-double-float
94 (bit 0 1 simple-bit-vector
95 :complex-typecode #.sb!vm:complex-bit-vector-widetag
97 ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come
98 ;; before their SIGNED-BYTE partners is significant in the
99 ;; implementation of the compiler; some of the cross-compiler
100 ;; code (see e.g. COERCE-TO-SMALLEST-ELTYPE in
101 ;; src/compiler/debug-dump.lisp) attempts to create an array
102 ;; specialized on (UNSIGNED-BYTE FOO), where FOO could be 7;
103 ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're
104 ;; not careful we could get the wrong specialized array when
105 ;; we try to FIND-IF, below. -- CSR, 2002-07-08
106 ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2
108 ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4
110 ((unsigned-byte 7) 0 8 simple-array-unsigned-byte-7
112 ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8
114 ((unsigned-byte 15) 0 16 simple-array-unsigned-byte-15
116 ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16
118 #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
119 ((unsigned-byte 29) 0 32 simple-array-unsigned-byte-29
122 ((unsigned-byte 31) 0 32 simple-array-unsigned-byte-31
124 ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32
126 #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
127 ((unsigned-byte 60) 0 64 simple-array-unsigned-byte-60
130 #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
131 ((unsigned-byte 63) 0 64 simple-array-unsigned-byte-63
133 #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
134 ((unsigned-byte 64) 0 64 simple-array-unsigned-byte-64
136 ((signed-byte 8) 0 8 simple-array-signed-byte-8
138 ((signed-byte 16) 0 16 simple-array-signed-byte-16
140 ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX,
141 ;; compiler/generic/primtype.lisp, for why this is FIXNUM and
142 ;; not (SIGNED-BYTE 30)
143 #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
144 (fixnum 0 32 simple-array-signed-byte-30
147 ((signed-byte 32) 0 32 simple-array-signed-byte-32
149 ;; KLUDGE: see above KLUDGE for the 32-bit case
150 #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
151 (fixnum 0 64 simple-array-signed-byte-61
154 #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
155 ((signed-byte 64) 0 64 simple-array-signed-byte-64
157 ((complex single-float) #C(0.0f0 0.0f0) 64
158 simple-array-complex-single-float
160 ((complex double-float) #C(0.0d0 0.0d0) 128
161 simple-array-complex-double-float
164 ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256
165 simple-array-complex-long-float
167 (t 0 #.sb!vm:n-word-bits simple-vector :importance 18))))
169 (defun valid-bit-bash-saetp-p (saetp)
170 ;; BIT-BASHing isn't allowed on simple vectors that contain pointers
171 (and (not (eq t (sb!vm:saetp-specifier saetp)))
172 ;; Disallowing (VECTOR NIL) also means that we won't transform
173 ;; sequence functions into bit-bashing code and we let the
174 ;; generic sequence functions signal errors if necessary.
175 (not (zerop (sb!vm:saetp-n-bits saetp)))
176 ;; Due to limitations with the current BIT-BASHing code, we can't
177 ;; BIT-BASH reliably on arrays whose element types are larger
178 ;; than the word size.
179 (<= (sb!vm:saetp-n-bits saetp) sb!vm:n-word-bits)))
181 (defvar sb!kernel::*specialized-array-element-types*
184 *specialized-array-element-type-properties*))
187 (defun !vm-type-cold-init ()
188 (setf sb!kernel::*specialized-array-element-types*
189 '#.sb!kernel::*specialized-array-element-types*))
191 (defvar *simple-array-primitive-types*
194 (cons (saetp-specifier saetp)
195 (saetp-primitive-type-name saetp)))
196 *specialized-array-element-type-properties*)
198 "An alist for mapping simple array element types to their
199 corresponding primitive types.")
201 (defvar *vector-without-complex-typecode-infos*
203 (loop for saetp across *specialized-array-element-type-properties*
204 for specifier = (saetp-specifier saetp)
205 unless (saetp-complex-typecode saetp)
206 collect (list (if (atom specifier)
207 (intern (format nil "VECTOR-~A-P" specifier))
208 ;; at the moment, all specialized array
209 ;; specifiers are either atoms or
210 ;; two-element lists.
211 (intern (format nil "VECTOR-~A-~A-P" (car specifier) (cadr specifier))))
214 '#.*vector-without-complex-typecode-infos*)
218 (defun find-saetp (element-type)
219 (find element-type sb!vm:*specialized-array-element-type-properties*
220 :key #'sb!vm:saetp-specifier :test #'equal))
222 (defun find-saetp-by-ctype (ctype)
223 (find ctype sb!vm:*specialized-array-element-type-properties*
224 :key #'sb!vm:saetp-ctype :test #'csubtypep))