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)
  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   ;; what we get when the low-level vector-creation logic zeroes all
  34   ;; the bits (which also serves as the default value of MAKE-ARRAY's
  35   ;; :INITIAL-ELEMENT keyword)
  36   (initial-element-default (missing-arg) :read-only t)
  37   ;; how many bits per element
  38   (n-bits (missing-arg) :type index :read-only t)
  39   ;; the low-level type code (aka "widetag")
  40   (typecode (missing-arg) :type index :read-only t)
  41   ;; if an integer, a typecode corresponding to a complex vector
  42   ;; specialized on this element type.
  43   (complex-typecode nil :type (or index null) :read-only t)
  44   ;; the name of the primitive type of data vectors specialized on
  45   ;; this type
  46   (primitive-type-name (missing-arg) :type symbol :read-only t)
  47   ;; the number of extra elements we use at the end of the array for
  48   ;; low level hackery (e.g., one element for arrays of BASE-CHAR,
  49   ;; which is used for a fixed #\NULL so that when we call out to C
  50   ;; we don't need to cons a new copy)
  51   (n-pad-elements (missing-arg) :type index :read-only t)
  52   ;; the relative importance of this array type.  Used for determining
  53   ;; the order of the TYPECASE in HAIRY-DATA-VECTOR-{REF,SET}.  High
  54   ;; positive numbers are near the top; low negative numbers near the
  55   ;; bottom.
  56   (importance (missing-arg) :type fixnum :read-only t))
  57
  58 (defparameter *specialized-array-element-type-properties*
  59   (map 'simple-vector
  60        (lambda (args)
  61          (apply #'!make-saetp args))
  62        `(;; Erm.  Yeah.  There aren't a lot of things that make sense
  63          ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
  64          (nil #:mu 0 simple-array-nil
  65               :complex-typecode #.sb!vm:complex-vector-nil-widetag
  66               :importance 0)
  67          #!-sb-unicode
  68          (character ,(code-char 0) 8 simple-base-string
  69                     ;; (SIMPLE-BASE-STRINGs are stored with an extra
  70                     ;; trailing #\NULL for convenience in calling out
  71                     ;; to C.)
  72                     :n-pad-elements 1
  73                     :complex-typecode #.sb!vm:complex-base-string-widetag
  74                     :importance 17)
  75          #!+sb-unicode
  76          (base-char ,(code-char 0) 8 simple-base-string
  77                     ;; (SIMPLE-BASE-STRINGs are stored with an extra
  78                     ;; trailing #\NULL for convenience in calling out
  79                     ;; to C.)
  80                     :n-pad-elements 1
  81                     :complex-typecode #.sb!vm:complex-base-string-widetag
  82                     :importance 17)
  83          #!+sb-unicode
  84          (character ,(code-char 0) 32 simple-character-string
  85                     :n-pad-elements 1
  86                     :complex-typecode #.sb!vm:complex-character-string-widetag
  87                     :importance 17)
  88          (single-float 0.0f0 32 simple-array-single-float
  89           :importance 6)
  90          (double-float 0.0d0 64 simple-array-double-float
  91           :importance 5)
  92          (bit 0 1 simple-bit-vector
  93               :complex-typecode #.sb!vm:complex-bit-vector-widetag
  94               :importance 16)
  95          ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come
  96          ;; before their SIGNED-BYTE partners is significant in the
  97          ;; implementation of the compiler; some of the cross-compiler
  98          ;; code (see e.g. COERCE-TO-SMALLEST-ELTYPE in
  99          ;; src/compiler/debug-dump.lisp) attempts to create an array
 100          ;; specialized on (UNSIGNED-BYTE FOO), where FOO could be 7;
 101          ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're
 102          ;; not careful we could get the wrong specialized array when
 103          ;; we try to FIND-IF, below. -- CSR, 2002-07-08
 104          ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2
 105                             :importance 15)
 106          ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4
 107                             :importance 14)
 108          ((unsigned-byte 7) 0 8 simple-array-unsigned-byte-7
 109                             :importance 13)
 110          ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8
 111           :importance 13)
 112          ((unsigned-byte 15) 0 16 simple-array-unsigned-byte-15
 113           :importance 12)
 114          ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16
 115           :importance 12)
 116          #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
 117          ((unsigned-byte 29) 0 32 simple-array-unsigned-byte-29
 118           :importance 8)
 119          ((unsigned-byte 31) 0 32 simple-array-unsigned-byte-31
 120           :importance 11)
 121          ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32
 122           :importance 11)
 123          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
 124          ((unsigned-byte 60) 0 64 simple-array-unsigned-byte-60
 125           :importance 8)
 126          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
 127          ((unsigned-byte 63) 0 64 simple-array-unsigned-byte-63
 128           :importance 9)
 129          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
 130          ((unsigned-byte 64) 0 64 simple-array-unsigned-byte-64
 131           :importance 9)
 132          ((signed-byte 8) 0 8 simple-array-signed-byte-8
 133           :importance 10)
 134          ((signed-byte 16) 0 16 simple-array-signed-byte-16
 135           :importance 9)
 136          ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX,
 137          ;; compiler/generic/primtype.lisp, for why this is FIXNUM and
 138          ;; not (SIGNED-BYTE 30)
 139          #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
 140          (fixnum 0 32 simple-array-signed-byte-30
 141           :importance 8)
 142          ((signed-byte 32) 0 32 simple-array-signed-byte-32
 143           :importance 7)
 144          ;; KLUDGE: see above KLUDGE for the 32-bit case
 145          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
 146          (fixnum 0 64 simple-array-signed-byte-61
 147           :importance 8)
 148          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
 149          ((signed-byte 64) 0 64 simple-array-signed-byte-64
 150           :importance 7)
 151          ((complex single-float) #C(0.0f0 0.0f0) 64
 152           simple-array-complex-single-float
 153           :importance 3)
 154          ((complex double-float) #C(0.0d0 0.0d0) 128
 155           simple-array-complex-double-float
 156           :importance 2)
 157          #!+long-float
 158          ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256
 159           simple-array-complex-long-float
 160           :importance 1)
 161          (t 0 #.sb!vm:n-word-bits simple-vector :importance 18))))
 162
 163 (defvar sb!kernel::*specialized-array-element-types*
 164   (map 'list
 165        #'saetp-specifier
 166        *specialized-array-element-type-properties*))
 167
 168 #-sb-xc-host
 169 (defun !vm-type-cold-init ()
 170   (setf sb!kernel::*specialized-array-element-types*
 171         '#.sb!kernel::*specialized-array-element-types*))
 172
 173 (defvar *simple-array-primitive-types*
 174   (map 'list
 175        (lambda (saetp)
 176          (cons (saetp-specifier saetp)
 177                (saetp-primitive-type-name saetp)))
 178        *specialized-array-element-type-properties*)
 179   #!+sb-doc
 180   "An alist for mapping simple array element types to their
 181 corresponding primitive types.")
 182
 183 (in-package "SB!C")
 184
 185 (defun find-saetp (element-type)
 186   (find element-type sb!vm:*specialized-array-element-type-properties*
 187         :key #'sb!vm:saetp-specifier :test #'equal))