Commiting fix by Doug Katzman: disassembler missing ",8" on SHLD
[sbcl.git] / src / compiler / generic / vm-array.lisp
1 ;;;; this file centralizes information about the array types
2 ;;;; implemented by the system, where previously such information was
3 ;;;; spread over several files.
4
5 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; more information.
7 ;;;;
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.
13
14 (in-package "SB!VM")
15
16 (defstruct (specialized-array-element-type-properties
17             (:conc-name saetp-)
18             (:constructor
19              !make-saetp
20              (specifier
21               initial-element-default
22               n-bits
23               primitive-type-name
24               &key (n-pad-elements 0) complex-typecode (importance 0) fixnum-p
25               &aux (typecode
26                     (symbol-value (symbolicate primitive-type-name "-WIDETAG")))))
27             (:copier nil))
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
47   ;; this type
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
57   ;; bottom.
58   (importance (missing-arg) :type fixnum :read-only t))
59
60 (defparameter *specialized-array-element-type-properties*
61   (map 'simple-vector
62        (lambda (args)
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
68               :importance 0)
69          #!-sb-unicode
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
73                     ;; to C.)
74                     :n-pad-elements 1
75                     :complex-typecode #.sb!vm:complex-base-string-widetag
76                     :importance 17)
77          #!+sb-unicode
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
81                     ;; to C.)
82                     :n-pad-elements 1
83                     :complex-typecode #.sb!vm:complex-base-string-widetag
84                     :importance 17)
85          #!+sb-unicode
86          (character ,(code-char 0) 32 simple-character-string
87                     :n-pad-elements 1
88                     :complex-typecode #.sb!vm:complex-character-string-widetag
89                     :importance 17)
90          (single-float 0.0f0 32 simple-array-single-float
91           :importance 6)
92          (double-float 0.0d0 64 simple-array-double-float
93           :importance 5)
94          (bit 0 1 simple-bit-vector
95               :complex-typecode #.sb!vm:complex-bit-vector-widetag
96               :importance 16)
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
107                             :importance 15)
108          ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4
109                             :importance 14)
110          ((unsigned-byte 7) 0 8 simple-array-unsigned-byte-7
111                             :importance 13)
112          ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8
113           :importance 13)
114          ((unsigned-byte 15) 0 16 simple-array-unsigned-byte-15
115           :importance 12)
116          ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16
117           :importance 12)
118          #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
119          ((unsigned-byte #.sb!vm:n-positive-fixnum-bits)
120           0 32 simple-array-unsigned-fixnum
121           :importance 8
122           :fixnum-p t)
123          ((unsigned-byte 31) 0 32 simple-array-unsigned-byte-31
124           :importance 11)
125          ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32
126           :importance 11)
127          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
128          ((unsigned-byte #.sb!vm:n-positive-fixnum-bits)
129           0 64 simple-array-unsigned-fixnum
130           :importance 8
131           :fixnum-p t)
132          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
133          ((unsigned-byte 63) 0 64 simple-array-unsigned-byte-63
134           :importance 9)
135          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
136          ((unsigned-byte 64) 0 64 simple-array-unsigned-byte-64
137           :importance 9)
138          ((signed-byte 8) 0 8 simple-array-signed-byte-8
139           :importance 10)
140          ((signed-byte 16) 0 16 simple-array-signed-byte-16
141           :importance 9)
142          ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX,
143          ;; compiler/generic/primtype.lisp, for why this is FIXNUM and
144          ;; not (SIGNED-BYTE 30)
145          #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
146          (fixnum 0 32 simple-array-fixnum
147           :importance 8
148           :fixnum-p t)
149          ((signed-byte 32) 0 32 simple-array-signed-byte-32
150           :importance 7)
151          ;; KLUDGE: see above KLUDGE for the 32-bit case
152          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
153          (fixnum 0 64 simple-array-fixnum
154           :importance 8
155           :fixnum-p t)
156          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
157          ((signed-byte 64) 0 64 simple-array-signed-byte-64
158           :importance 7)
159          ((complex single-float) #C(0.0f0 0.0f0) 64
160           simple-array-complex-single-float
161           :importance 3)
162          ((complex double-float) #C(0.0d0 0.0d0) 128
163           simple-array-complex-double-float
164           :importance 2)
165          #!+long-float
166          ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256
167           simple-array-complex-long-float
168           :importance 1)
169          (t 0 #.sb!vm:n-word-bits simple-vector :importance 18))))
170
171 (defun valid-bit-bash-saetp-p (saetp)
172   ;; BIT-BASHing isn't allowed on simple vectors that contain pointers
173   (and (not (eq t (sb!vm:saetp-specifier saetp)))
174        ;; Disallowing (VECTOR NIL) also means that we won't transform
175        ;; sequence functions into bit-bashing code and we let the
176        ;; generic sequence functions signal errors if necessary.
177        (not (zerop (sb!vm:saetp-n-bits saetp)))
178        ;; Due to limitations with the current BIT-BASHing code, we can't
179        ;; BIT-BASH reliably on arrays whose element types are larger
180        ;; than the word size.
181        (<= (sb!vm:saetp-n-bits saetp) sb!vm:n-word-bits)))
182
183 (defvar sb!kernel::*specialized-array-element-types*
184   (map 'list
185        #'saetp-specifier
186        *specialized-array-element-type-properties*))
187
188 #-sb-xc-host
189 (defun !vm-type-cold-init ()
190   (setf sb!kernel::*specialized-array-element-types*
191         '#.sb!kernel::*specialized-array-element-types*))
192
193 (defvar *simple-array-primitive-types*
194   (map 'list
195        (lambda (saetp)
196          (cons (saetp-specifier saetp)
197                (saetp-primitive-type-name saetp)))
198        *specialized-array-element-type-properties*)
199   #!+sb-doc
200   "An alist for mapping simple array element types to their
201 corresponding primitive types.")
202
203 (defvar *vector-without-complex-typecode-infos*
204   #+sb-xc-host
205   (loop for saetp across *specialized-array-element-type-properties*
206         for specifier = (saetp-specifier saetp)
207         unless (saetp-complex-typecode saetp)
208         collect (list (if (atom specifier)
209                           (intern (format nil "VECTOR-~A-P" specifier))
210                           ;; at the moment, all specialized array
211                           ;; specifiers are either atoms or
212                           ;; two-element lists.
213                           (intern (format nil "VECTOR-~A-~A-P" (car specifier) (cadr specifier))))
214                       specifier))
215   #-sb-xc-host
216   '#.*vector-without-complex-typecode-infos*)
217
218 (in-package "SB!C")
219
220 (defun find-saetp (element-type)
221   (find element-type sb!vm:*specialized-array-element-type-properties*
222         :key #'sb!vm:saetp-specifier :test #'equal))
223
224 (defun find-saetp-by-ctype (ctype)
225   (find ctype sb!vm:*specialized-array-element-type-properties*
226         :key #'sb!vm:saetp-ctype :test #'csubtypep))