+;;;; this file centralizes information about the array types
+;;;; implemented by the system, where previously such information was
+;;;; spread over several files.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!VM")
+
+(defstruct (specialized-array-element-type-properties
+ (:conc-name saetp-)
+ (:constructor
+ !make-saetp
+ (specifier
+ initial-element-default
+ n-bits
+ primitive-type-name
+ &key (n-pad-elements 0)
+ &aux (typecode
+ (eval (symbolicate primitive-type-name "-WIDETAG")))))
+ (:copier nil))
+ ;; the element specifier, e.g. BASE-CHAR or (UNSIGNED-BYTE 4)
+ (specifier (missing-arg) :type type-specifier :read-only t)
+ ;; the element type, e.g. #<BUILT-IN-CLASS BASE-CHAR (sealed)> or
+ ;; #<SB-KERNEL:NUMERIC-TYPE (UNSIGNED-BYTE 4)>
+ (ctype nil :type (or ctype null))
+ ;; what we get when the low-level vector-creation logic zeroes all
+ ;; the bits (which also serves as the default value of MAKE-ARRAY's
+ ;; :INITIAL-ELEMENT keyword)
+ (initial-element-default (missing-arg) :read-only t)
+ ;; how many bits per element
+ (n-bits (missing-arg) :type index :read-only t)
+ ;; the low-level type code (aka "widetag")
+ (typecode (missing-arg) :type index :read-only t)
+ ;; the name of the primitive type of data vectors specialized on
+ ;; this type
+ (primitive-type-name (missing-arg) :type symbol :read-only t)
+ ;; the number of extra elements we use at the end of the array for
+ ;; low level hackery (e.g., one element for arrays of BASE-CHAR,
+ ;; which is used for a fixed #\NULL so that when we call out to C
+ ;; we don't need to cons a new copy)
+ (n-pad-elements (missing-arg) :type index :read-only t))
+
+(defparameter *specialized-array-element-type-properties*
+ (map 'simple-vector
+ (lambda (args)
+ (apply #'!make-saetp args))
+ `(;; Erm. Yeah. There aren't a lot of things that make sense
+ ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
+ (nil #:mu 0 simple-array-nil)
+ (base-char ,(code-char 0) 8 simple-base-string
+ ;; (SIMPLE-BASE-STRINGs are stored with an extra
+ ;; trailing #\NULL for convenience in calling out
+ ;; to C.)
+ :n-pad-elements 1)
+ (single-float 0.0f0 32 simple-array-single-float)
+ (double-float 0.0d0 64 simple-array-double-float)
+ #!+long-float
+ (long-float 0.0l0 #!+x86 96 #!+sparc 128 simple-array-long-float)
+ (bit 0 1 simple-bit-vector)
+ ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come
+ ;; before their SIGNED-BYTE partners is significant in the
+ ;; implementation of the compiler; some of the cross-compiler
+ ;; code (see e.g. COERCE-TO-SMALLEST-ELTYPE in
+ ;; src/compiler/debug-dump.lisp) attempts to create an array
+ ;; specialized on (UNSIGNED-BYTE FOO), where FOO could be 7;
+ ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're
+ ;; not careful we could get the wrong specialized array when
+ ;; we try to FIND-IF, below. -- CSR, 2002-07-08
+ ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2)
+ ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4)
+ ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8)
+ ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16)
+ ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32)
+ ((signed-byte 8) 0 8 simple-array-signed-byte-8)
+ ((signed-byte 16) 0 16 simple-array-signed-byte-16)
+ ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX,
+ ;; compiler/generic/primtype.lisp, for why this is FIXNUM and
+ ;; not (SIGNED-BYTE 30)
+ (fixnum 0 32 simple-array-signed-byte-30)
+ ((signed-byte 32) 0 32 simple-array-signed-byte-32)
+ ((complex single-float) #C(0.0f0 0.0f0) 64
+ simple-array-complex-single-float)
+ ((complex double-float) #C(0.0d0 0.0d0) 128
+ simple-array-complex-double-float)
+ #!+long-float
+ ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256
+ simple-array-complex-long-float)
+ (t 0 32 simple-vector))))
+
+(defvar sb!kernel::*specialized-array-element-types*
+ (map 'list
+ #'saetp-specifier
+ *specialized-array-element-type-properties*))
+
+#-sb-xc-host
+(defun !vm-type-cold-init ()
+ (setf sb!kernel::*specialized-array-element-types*
+ '#.sb!kernel::*specialized-array-element-types*))
+
+(defvar *simple-array-primitive-types*
+ (map 'list
+ (lambda (saetp)
+ (cons (saetp-specifier saetp)
+ (saetp-primitive-type-name saetp)))
+ *specialized-array-element-type-properties*)
+ #!+sb-doc
+ "An alist for mapping simple array element types to their
+corresponding primitive types.")