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   ;; TYPE-SPECIFIER is too general - this doesn't allow CLASS/CLASSOID.
  30   (specifier (missing-arg) :type (or symbol list) :read-only t)
  31   ;; the element type, e.g. #<BUILT-IN-CLASS BASE-CHAR (sealed)> or
  32   ;; #<SB-KERNEL:NUMERIC-TYPE (UNSIGNED-BYTE 4)>
  33   (ctype nil :type (or ctype null))
  34   ;; true if the elements are tagged fixnums
  35   (fixnum-p nil :type boolean :read-only t)
  36   ;; what we get when the low-level vector-creation logic zeroes all
  37   ;; the bits (which also serves as the default value of MAKE-ARRAY's
  38   ;; :INITIAL-ELEMENT keyword)
  39   (initial-element-default (missing-arg) :read-only t)
  40   ;; how many bits per element
  41   (n-bits (missing-arg) :type index :read-only t)
  42   ;; the low-level type code (aka "widetag")
  43   (typecode (missing-arg) :type index :read-only t)
  44   ;; if an integer, a typecode corresponding to a complex vector
  45   ;; specialized on this element type.
  46   (complex-typecode nil :type (or index null) :read-only t)
  47   ;; the name of the primitive type of data vectors specialized on
  48   ;; this type
  49   (primitive-type-name (missing-arg) :type symbol :read-only t)
  50   ;; the number of extra elements we use at the end of the array for
  51   ;; low level hackery (e.g., one element for arrays of BASE-CHAR,
  52   ;; which is used for a fixed #\NULL so that when we call out to C
  53   ;; we don't need to cons a new copy)
  54   (n-pad-elements (missing-arg) :type index :read-only t)
  55   ;; the relative importance of this array type.  Previously used for
  56   ;; determining the order of the TYPECASE in
  57   ;; HAIRY-DATA-VECTOR-{REF,SET}; currently (as of 2013-09-18) unused.
  58   (importance (missing-arg) :type fixnum :read-only t))
  59
  60 ;; Simulate DEFINE-LOAD-TIME-GLOBAL - always bound in the image
  61 ;; but not eval'd in the compiler.
  62 (defglobal *specialized-array-element-type-properties* nil)
  63 (setq *specialized-array-element-type-properties*
  64   (map 'simple-vector
  65        (lambda (args)
  66          (apply #'!make-saetp args))
  67        `(;; Erm.  Yeah.  There aren't a lot of things that make sense
  68          ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
  69          (nil #:mu 0 simple-array-nil
  70               :complex-typecode #.complex-vector-nil-widetag
  71               :importance 0)
  72          #!-sb-unicode
  73          (character ,(code-char 0) 8 simple-base-string
  74                     ;; (SIMPLE-BASE-STRINGs are stored with an extra
  75                     ;; trailing #\NULL for convenience in calling out
  76                     ;; to C.)
  77                     :n-pad-elements 1
  78                     :complex-typecode #.complex-base-string-widetag
  79                     :importance 17)
  80          #!+sb-unicode
  81          (base-char ,(code-char 0) 8 simple-base-string
  82                     ;; (SIMPLE-BASE-STRINGs are stored with an extra
  83                     ;; trailing #\NULL for convenience in calling out
  84                     ;; to C.)
  85                     :n-pad-elements 1
  86                     :complex-typecode #.complex-base-string-widetag
  87                     :importance 17)
  88          #!+sb-unicode
  89          (character ,(code-char 0) 32 simple-character-string
  90                     :n-pad-elements 1
  91                     :complex-typecode #.complex-character-string-widetag
  92                     :importance 17)
  93          (single-float 0.0f0 32 simple-array-single-float
  94           :importance 6)
  95          (double-float 0.0d0 64 simple-array-double-float
  96           :importance 5)
  97          (bit 0 1 simple-bit-vector
  98               :complex-typecode #.complex-bit-vector-widetag
  99               :importance 16)
 100          ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come
 101          ;; before their SIGNED-BYTE partners is significant in the
 102          ;; implementation of the compiler; some of the cross-compiler
 103          ;; code (see e.g. COERCE-TO-SMALLEST-ELTYPE in
 104          ;; src/compiler/debug-dump.lisp) attempts to create an array
 105          ;; specialized on (UNSIGNED-BYTE FOO), where FOO could be 7;
 106          ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're
 107          ;; not careful we could get the wrong specialized array when
 108          ;; we try to FIND-IF, below. -- CSR, 2002-07-08
 109          ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2
 110                             :importance 15)
 111          ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4
 112                             :importance 14)
 113          ((unsigned-byte 7) 0 8 simple-array-unsigned-byte-7
 114                             :importance 13)
 115          ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8
 116           :importance 13)
 117          ((unsigned-byte 15) 0 16 simple-array-unsigned-byte-15
 118           :importance 12)
 119          ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16
 120           :importance 12)
 121          #!-64-bit
 122          ((unsigned-byte #.n-positive-fixnum-bits)
 123           0 32 simple-array-unsigned-fixnum
 124           :importance 8
 125           :fixnum-p t)
 126          ((unsigned-byte 31) 0 32 simple-array-unsigned-byte-31
 127           :importance 11)
 128          ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32
 129           :importance 11)
 130          #!+64-bit
 131          ((unsigned-byte #.n-positive-fixnum-bits)
 132           0 64 simple-array-unsigned-fixnum
 133           :importance 8
 134           :fixnum-p t)
 135          #!+64-bit
 136          ((unsigned-byte 63) 0 64 simple-array-unsigned-byte-63
 137           :importance 9)
 138          #!+64-bit
 139          ((unsigned-byte 64) 0 64 simple-array-unsigned-byte-64
 140           :importance 9)
 141          ((signed-byte 8) 0 8 simple-array-signed-byte-8
 142           :importance 10)
 143          ((signed-byte 16) 0 16 simple-array-signed-byte-16
 144           :importance 9)
 145          ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX,
 146          ;; compiler/generic/primtype.lisp, for why this is FIXNUM and
 147          ;; not (SIGNED-BYTE 30)
 148          #!-64-bit
 149          (fixnum 0 32 simple-array-fixnum
 150           :importance 8
 151           :fixnum-p t)
 152          ((signed-byte 32) 0 32 simple-array-signed-byte-32
 153           :importance 7)
 154          ;; KLUDGE: see above KLUDGE for the 32-bit case
 155          #!+64-bit
 156          (fixnum 0 64 simple-array-fixnum
 157           :importance 8
 158           :fixnum-p t)
 159          #!+64-bit
 160          ((signed-byte 64) 0 64 simple-array-signed-byte-64
 161           :importance 7)
 162          ((complex single-float) #C(0.0f0 0.0f0) 64
 163           simple-array-complex-single-float
 164           :importance 3)
 165          ((complex double-float) #C(0.0d0 0.0d0) 128
 166           simple-array-complex-double-float
 167           :importance 2)
 168          #!+long-float
 169          ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256
 170           simple-array-complex-long-float
 171           :importance 1)
 172          (t 0 #.n-word-bits simple-vector :importance 18))))
 173
 174 ;; The compiler can see that the number of types that must be present in a
 175 ;; union of arrays to convert (OR (array t1) ... (array tN)) to (ARRAY *)
 176 ;; is a constant if (LENGTH *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*) is
 177 ;; a constant. So proclaim the type of the global var. This works because
 178 ;; the compiler doesn't retroactively try to check the initializer of NIL.
 179 #-sb-xc-host
 180 (declaim (type (simple-vector
 181                 #.(length *specialized-array-element-type-properties*))
 182                *specialized-array-element-type-properties*))
 183
 184 (defun valid-bit-bash-saetp-p (saetp)
 185   ;; BIT-BASHing isn't allowed on simple vectors that contain pointers
 186   (and (not (eq t (saetp-specifier saetp)))
 187        ;; Disallowing (VECTOR NIL) also means that we won't transform
 188        ;; sequence functions into bit-bashing code and we let the
 189        ;; generic sequence functions signal errors if necessary.
 190        (not (zerop (saetp-n-bits saetp)))
 191        ;; Due to limitations with the current BIT-BASHing code, we can't
 192        ;; BIT-BASH reliably on arrays whose element types are larger
 193        ;; than the word size.
 194        (<= (saetp-n-bits saetp) n-word-bits)))
 195
 196 #+sb-xc-host
 197 (defvar sb!kernel::*specialized-array-element-types*
 198   (map 'list
 199        #'saetp-specifier
 200        *specialized-array-element-type-properties*))
 201
 202 #-sb-xc-host
 203 (!defglobal sb!kernel::*specialized-array-element-types*
 204             '#.sb!kernel::*specialized-array-element-types*)
 205
 206 (defvar *vector-without-complex-typecode-infos*
 207   #+sb-xc-host
 208   (loop for saetp across *specialized-array-element-type-properties*
 209         for specifier = (saetp-specifier saetp)
 210         unless (saetp-complex-typecode saetp)
 211         collect (list (if (atom specifier)
 212                           (intern (format nil "VECTOR-~A-P" specifier))
 213                           ;; at the moment, all specialized array
 214                           ;; specifiers are either atoms or
 215                           ;; two-element lists.
 216                           (intern (format nil "VECTOR-~A-~A-P" (car specifier) (cadr specifier))))
 217                       specifier))
 218   #-sb-xc-host
 219   '#.*vector-without-complex-typecode-infos*)
 220
 221 (def!struct (room-info) ; FIXME: find a better home for this
 222   ;; the name of this type
 223   (name nil :type symbol)
 224   ;; kind of type (how to reconstitute an object)
 225   (kind (missing-arg)
 226         :type (member :other :small-other :closure :instance :list
 227                       :code :vector-nil :weak-pointer)))
 228 (!set-load-form-method room-info (:xc))
 229
 230 (in-package "SB!C")
 231
 232 (defun find-saetp (element-type)
 233   (find element-type sb!vm:*specialized-array-element-type-properties*
 234         :key #'sb!vm:saetp-specifier :test #'equal))
 235
 236 (defun find-saetp-by-ctype (ctype)
 237   (find ctype sb!vm:*specialized-array-element-type-properties*
 238         :key #'sb!vm:saetp-ctype :test #'csubtypep))