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. Previously used for
55 ;; determining the order of the TYPECASE in
56 ;; HAIRY-DATA-VECTOR-{REF,SET}; currently (as of 2013-09-18) unused.
57 (importance (missing-arg) :type fixnum
:read-only t
))
59 (defparameter *specialized-array-element-type-properties
*
62 (apply #'!make-saetp args
))
63 `(;; Erm. Yeah. There aren't a lot of things that make sense
64 ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
65 (nil #:mu
0 simple-array-nil
66 :complex-typecode
#.complex-vector-nil-widetag
69 (character ,(code-char 0) 8 simple-base-string
70 ;; (SIMPLE-BASE-STRINGs are stored with an extra
71 ;; trailing #\NULL for convenience in calling out
74 :complex-typecode
#.complex-base-string-widetag
77 (base-char ,(code-char 0) 8 simple-base-string
78 ;; (SIMPLE-BASE-STRINGs are stored with an extra
79 ;; trailing #\NULL for convenience in calling out
82 :complex-typecode
#.complex-base-string-widetag
85 (character ,(code-char 0) 32 simple-character-string
87 :complex-typecode
#.complex-character-string-widetag
89 (single-float 0.0f0
32 simple-array-single-float
91 (double-float 0.0d0
64 simple-array-double-float
93 (bit 0 1 simple-bit-vector
94 :complex-typecode
#.complex-bit-vector-widetag
96 ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come
97 ;; before their SIGNED-BYTE partners is significant in the
98 ;; implementation of the compiler; some of the cross-compiler
99 ;; code (see e.g. COERCE-TO-SMALLEST-ELTYPE in
100 ;; src/compiler/debug-dump.lisp) attempts to create an array
101 ;; specialized on (UNSIGNED-BYTE FOO), where FOO could be 7;
102 ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're
103 ;; not careful we could get the wrong specialized array when
104 ;; we try to FIND-IF, below. -- CSR, 2002-07-08
105 ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2
107 ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4
109 ((unsigned-byte 7) 0 8 simple-array-unsigned-byte-7
111 ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8
113 ((unsigned-byte 15) 0 16 simple-array-unsigned-byte-15
115 ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16
117 #!+#.
(cl:if
(cl:= 32 sb
!vm
:n-word-bits
) '(and) '(or))
118 ((unsigned-byte #.n-positive-fixnum-bits
)
119 0 32 simple-array-unsigned-fixnum
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 #.n-positive-fixnum-bits
)
128 0 64 simple-array-unsigned-fixnum
131 #!+#.
(cl:if
(cl:= 64 sb
!vm
:n-word-bits
) '(and) '(or))
132 ((unsigned-byte 63) 0 64 simple-array-unsigned-byte-63
134 #!+#.
(cl:if
(cl:= 64 sb
!vm
:n-word-bits
) '(and) '(or))
135 ((unsigned-byte 64) 0 64 simple-array-unsigned-byte-64
137 ((signed-byte 8) 0 8 simple-array-signed-byte-8
139 ((signed-byte 16) 0 16 simple-array-signed-byte-16
141 ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX,
142 ;; compiler/generic/primtype.lisp, for why this is FIXNUM and
143 ;; not (SIGNED-BYTE 30)
144 #!+#.
(cl:if
(cl:= 32 sb
!vm
:n-word-bits
) '(and) '(or))
145 (fixnum 0 32 simple-array-fixnum
148 ((signed-byte 32) 0 32 simple-array-signed-byte-32
150 ;; KLUDGE: see above KLUDGE for the 32-bit case
151 #!+#.
(cl:if
(cl:= 64 sb
!vm
:n-word-bits
) '(and) '(or))
152 (fixnum 0 64 simple-array-fixnum
155 #!+#.
(cl:if
(cl:= 64 sb
!vm
:n-word-bits
) '(and) '(or))
156 ((signed-byte 64) 0 64 simple-array-signed-byte-64
158 ((complex single-float
) #C
(0.0f0
0.0f0
) 64
159 simple-array-complex-single-float
161 ((complex double-float
) #C
(0.0d0
0.0d0
) 128
162 simple-array-complex-double-float
165 ((complex long-float
) #C
(0.0l0
0.0l0) #!+x86
192 #!+sparc
256
166 simple-array-complex-long-float
168 (t 0 #.n-word-bits simple-vector
:importance
18))))
170 (defun valid-bit-bash-saetp-p (saetp)
171 ;; BIT-BASHing isn't allowed on simple vectors that contain pointers
172 (and (not (eq t
(saetp-specifier saetp
)))
173 ;; Disallowing (VECTOR NIL) also means that we won't transform
174 ;; sequence functions into bit-bashing code and we let the
175 ;; generic sequence functions signal errors if necessary.
176 (not (zerop (saetp-n-bits saetp
)))
177 ;; Due to limitations with the current BIT-BASHing code, we can't
178 ;; BIT-BASH reliably on arrays whose element types are larger
179 ;; than the word size.
180 (<= (saetp-n-bits saetp
) n-word-bits
)))
182 (defvar sb
!kernel
::*specialized-array-element-types
*
185 *specialized-array-element-type-properties
*))
188 (defun !vm-type-cold-init
()
189 (setf sb
!kernel
::*specialized-array-element-types
*
190 '#.sb
!kernel
::*specialized-array-element-types
*))
192 (defvar *simple-array-primitive-types
*
195 (cons (saetp-specifier saetp
)
196 (saetp-primitive-type-name saetp
)))
197 *specialized-array-element-type-properties
*)
199 "An alist for mapping simple array element types to their
200 corresponding primitive types.")
202 (defvar *vector-without-complex-typecode-infos
*
204 (loop for saetp across
*specialized-array-element-type-properties
*
205 for specifier
= (saetp-specifier saetp
)
206 unless
(saetp-complex-typecode saetp
)
207 collect
(list (if (atom specifier
)
208 (intern (format nil
"VECTOR-~A-P" specifier
))
209 ;; at the moment, all specialized array
210 ;; specifiers are either atoms or
211 ;; two-element lists.
212 (intern (format nil
"VECTOR-~A-~A-P" (car specifier
) (cadr specifier
))))
215 '#.
*vector-without-complex-typecode-infos
*)
219 (defun find-saetp (element-type)
220 (find element-type sb
!vm
:*specialized-array-element-type-properties
*
221 :key
#'sb
!vm
:saetp-specifier
:test
#'equal
))
223 (defun find-saetp-by-ctype (ctype)
224 (find ctype sb
!vm
:*specialized-array-element-type-properties
*
225 :key
#'sb
!vm
:saetp-ctype
:test
#'csubtypep
))