From: Christophe Rhodes Date: Tue, 24 Jun 2003 10:56:11 +0000 (+0000) Subject: 0.8.0.78.vector-nil-string.7: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9767de1cecfe50560fe1da69fd458b6148a66da3;p=sbcl.git 0.8.0.78.vector-nil-string.7: The beginnings of the payoff: being sufficiently irritated by the baroque intertwinings of the different places where array types have to be specified, here is a beginning of a rationalization. ... make *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES* a master value, and derive three other compiler-internal lists from it. (net win so far: 3) ... but because it's made earlier so that we can use it as a master value, SPECIFIER-TYPE gives unknown types; a new file (and corresponding cold-init function) fixes up unknown types (and for primitive-types too) ... there are still plenty of places left where array logic isn't derived from *SAETP*; they will be worked on. --- diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 4b8fbb7..28b3f1d 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -334,6 +334,7 @@ ;; in class.lisp. ("src/code/condition" :not-host) + ("src/compiler/generic/vm-array") ("src/compiler/generic/primtype") ;; the implementation of the compiler-affecting part of forms like @@ -398,7 +399,11 @@ ("src/compiler/compiler-error") ("src/code/type-init") - + + ;; Now that the type system is initialized, fix up UNKNOWN types that + ;; have crept in. + ("src/compiler/fixup-type") + ;; These define target types needed by fndb.lisp. ("src/code/package") ("src/code/random") diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 03cd050..96d96ef 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1404,6 +1404,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "!TYPE-CLASS-COLD-INIT" "!TYPEDEFS-COLD-INIT" "!ALIEN-TYPE-COLD-INIT" "!CLASSES-COLD-INIT" "!EARLY-TYPE-COLD-INIT" "!LATE-TYPE-COLD-INIT" + "!FIXUP-TYPE-COLD-INIT" "!TARGET-TYPE-COLD-INIT" "!RANDOM-COLD-INIT" "!READER-COLD-INIT" "!TYPECHECKFUNS-COLD-INIT" "STREAM-COLD-INIT-OR-RESET" "!LOADER-COLD-INIT" @@ -2008,6 +2009,10 @@ structure representations" "*READ-ONLY-SPACE-FREE-POINTER*" "REGISTER-SAVE-PENALTY" "RETURN-PC-HEADER-WIDETAG" "RETURN-PC-RETURN-POINT-OFFSET" "RETURN-PC-SAVE-OFFSET" + "SAETP-CTYPE" "SAETP-INITIAL-ELEMENT-DEFAULT" + "SAETP-N-BITS" "SAETP-TYPECODE" "SAETP-PRIMTYPE" + "SAETP-N-PAD-ELEMENTS" "SAETP-SPECIFIER" + "*SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*" "SANCTIFY-FOR-EXECUTION" "SAP-POINTER-SLOT" "SAP-REG-SC-NUMBER" "SAP-SIZE" "SAP-STACK-SC-NUMBER" "SAP-WIDETAG" diff --git a/src/code/array.lisp b/src/code/array.lisp index 1b3d506..e951999 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -316,11 +316,13 @@ ;;;; accessor/setter functions (eval-when (:compile-toplevel :execute) (defparameter *specialized-array-element-types* + ;; FIXME: Ideally we would generate this list from + ;; SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES. However, this list + ;; is optimized for frequency of occurrence, not type lattice + ;; relationships, so it's tricky to do so cleanly. '(t character bit - (unsigned-byte 2) - (unsigned-byte 4) (unsigned-byte 8) (unsigned-byte 16) (unsigned-byte 32) @@ -334,6 +336,8 @@ (complex single-float) (complex double-float) #!+long-float (complex long-float) + (unsigned-byte 4) + (unsigned-byte 2) nil))) (defun hairy-data-vector-ref (array index) @@ -877,8 +881,7 @@ (unless (array-header-p vector) (macrolet ((frob (name &rest things) `(etypecase ,name - ((simple-array nil (*)) (error 'cell-error - :name 'nil-array-element)) + ((simple-array nil (*)) (error 'nil-array-accessed-error)) ,@(mapcar (lambda (thing) (destructuring-bind (type-spec fill-value) thing diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index cb4c684..06f78ba 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -204,6 +204,9 @@ ;; DEFTYPEs are. (setf *type-system-initialized* t) + ;; now that the type system is definitely initialized, fixup UNKNOWN + ;; types that have crept in. + (show-and-call !fixup-type-cold-init) ;; run the PROCLAIMs. (show-and-call !late-proclaim-cold-init) diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp index 7b6648b..cea2e9b 100644 --- a/src/code/deftypes-for-target.lisp +++ b/src/code/deftypes-for-target.lisp @@ -106,14 +106,6 @@ ;;; semistandard types (sb!xc:deftype generalized-boolean () t) -;;; a type specifier -;;; -;;; FIXME: The SB!KERNEL:INSTANCE here really means CL:CLASS. -;;; However, the CL:CLASS type is only defined once PCL is loaded, -;;; which is before this is evaluated. Once PCL is moved into cold -;;; init, this might be fixable. -(sb!xc:deftype type-specifier () '(or list symbol sb!kernel:instance)) - ;;; array rank, total size... (sb!xc:deftype array-rank () `(integer 0 (,sb!xc:array-rank-limit))) (sb!xc:deftype array-total-size () diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 61c6404..523754f 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -79,6 +79,14 @@ (t `(values ,@(cdr result) &optional))))) `(function ,args ,result))) +;;; a type specifier +;;; +;;; FIXME: The SB!KERNEL:INSTANCE here really means CL:CLASS. +;;; However, the CL:CLASS type is only defined once PCL is loaded, +;;; which is before this is evaluated. Once PCL is moved into cold +;;; init, this might be fixable. +(def!type type-specifier () '(or list symbol sb!kernel:instance)) + ;;; the default value used for initializing character data. The ANSI ;;; spec says this is arbitrary, so we use the value that falls ;;; through when we just let the low-level consing code initialize diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index df88690..d425b36 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -197,77 +197,6 @@ ,@(when initial-element '(:initial-element initial-element))))) -(defstruct (specialized-array-element-type-properties - (:conc-name saetp-) - (:constructor !make-saetp (ctype - initial-element-default - n-bits - typecode - &key - (n-pad-elements 0))) - (:copier nil)) - ;; the element type, e.g. # or - ;; # - (ctype (missing-arg) :type ctype :read-only t) - ;; 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 - (typecode (missing-arg) :type index :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) - (destructuring-bind (type-spec &rest rest) args - (let ((ctype (specifier-type type-spec))) - (apply #'!make-saetp ctype rest)))) - `(;; 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 ,sb!vm:simple-array-nil-widetag) - (base-char ,(code-char 0) 8 ,sb!vm:simple-base-string-widetag - ;; (SIMPLE-STRINGs are stored with an extra trailing - ;; #\NULL for convenience in calling out to C.) - :n-pad-elements 1) - (single-float 0.0f0 32 ,sb!vm:simple-array-single-float-widetag) - (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-widetag) - #!+long-float (long-float 0.0L0 #!+x86 96 #!+sparc 128 - ,sb!vm:simple-array-long-float-widetag) - (bit 0 1 ,sb!vm:simple-bit-vector-widetag) - ;; 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 ,sb!vm:simple-array-unsigned-byte-2-widetag) - ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-widetag) - ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-widetag) - ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-widetag) - ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-widetag) - ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-widetag) - ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-widetag) - ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-widetag) - ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-widetag) - ((complex single-float) #C(0.0f0 0.0f0) 64 - ,sb!vm:simple-array-complex-single-float-widetag) - ((complex double-float) #C(0.0d0 0.0d0) 128 - ,sb!vm:simple-array-complex-double-float-widetag) - #!+long-float ((complex long-float) #C(0.0L0 0.0L0) - #!+x86 192 #!+sparc 256 - ,sb!vm:simple-array-complex-long-float-widetag) - (t 0 32 ,sb!vm:simple-vector-widetag)))) - (deftransform make-array ((dims &key initial-element element-type adjustable fill-pointer) (t &rest *)) @@ -281,10 +210,10 @@ (continuation-value element-type)))) (eltype-type (ir1-transform-specifier-type eltype)) (saetp (find-if (lambda (saetp) - (csubtypep eltype-type (saetp-ctype saetp))) - *specialized-array-element-type-properties*)) + (csubtypep eltype-type (sb!vm:saetp-ctype saetp))) + sb!vm:*specialized-array-element-type-properties*)) (creation-form `(make-array dims - :element-type ',(type-specifier (saetp-ctype saetp)) + :element-type ',(type-specifier (sb!vm:saetp-ctype saetp)) ,@(when fill-pointer '(:fill-pointer fill-pointer)) ,@(when adjustable @@ -295,7 +224,7 @@ (cond ((and (constant-continuation-p initial-element) (eql (continuation-value initial-element) - (saetp-initial-element-default saetp))) + (sb!vm:saetp-initial-element-default saetp))) creation-form) (t ;; error checking for target, disabled on the host because @@ -304,13 +233,13 @@ (when (constant-continuation-p initial-element) (let ((value (continuation-value initial-element))) (cond - ((not (ctypep value (saetp-ctype saetp))) + ((not (ctypep value (sb!vm:saetp-ctype saetp))) ;; this case will cause an error at runtime, so we'd ;; better WARN about it now. (compiler-warn "~@<~S is not a ~S (which is the ~ UPGRADED-ARRAY-ELEMENT-TYPE of ~S).~@:>" value - (type-specifier (saetp-ctype saetp)) + (type-specifier (sb!vm:saetp-ctype saetp)) eltype)) ((not (ctypep value eltype-type)) ;; this case will not cause an error at runtime, but @@ -342,13 +271,13 @@ (result-type-spec `(simple-array ,eltype (,len))) (eltype-type (ir1-transform-specifier-type eltype)) (saetp (find-if (lambda (saetp) - (csubtypep eltype-type (saetp-ctype saetp))) - *specialized-array-element-type-properties*))) + (csubtypep eltype-type (sb!vm:saetp-ctype saetp))) + sb!vm:*specialized-array-element-type-properties*))) (unless saetp (give-up-ir1-transform "cannot open-code creation of ~S" result-type-spec)) #-sb-xc-host - (unless (csubtypep (ctype-of (saetp-initial-element-default saetp)) + (unless (csubtypep (ctype-of (sb!vm:saetp-initial-element-default saetp)) eltype-type) ;; This situation arises e.g. in (MAKE-ARRAY 4 :ELEMENT-TYPE ;; '(INTEGER 1 5)) ANSI's definition of MAKE-ARRAY says "If @@ -361,11 +290,11 @@ ;; he writes code:-), we'll signal a STYLE-WARNING in case he ;; didn't realize this. (compiler-style-warn "The default initial element ~S is not a ~S." - (saetp-initial-element-default saetp) + (sb!vm:saetp-initial-element-default saetp) eltype)) - (let* ((n-bits-per-element (saetp-n-bits saetp)) - (typecode (saetp-typecode saetp)) - (n-pad-elements (saetp-n-pad-elements saetp)) + (let* ((n-bits-per-element (sb!vm:saetp-n-bits saetp)) + (typecode (sb!vm:saetp-typecode saetp)) + (n-pad-elements (sb!vm:saetp-n-pad-elements saetp)) (padded-length-form (if (zerop n-pad-elements) 'length `(+ length ,n-pad-elements))) diff --git a/src/compiler/fixup-type.lisp b/src/compiler/fixup-type.lisp new file mode 100644 index 0000000..0c101f4 --- /dev/null +++ b/src/compiler/fixup-type.lisp @@ -0,0 +1,28 @@ +(in-package "SB!C") + +(!begin-collecting-cold-init-forms) + +(!cold-init-forms + (map 'nil + (lambda (saetp) + (setf (sb!vm:saetp-ctype saetp) + (specifier-type (sb!vm:saetp-specifier saetp)))) + sb!vm:*specialized-array-element-type-properties*)) + +(!cold-init-forms + (maphash + (lambda (key value) + (declare (ignore key)) + (setf (primitive-type-type value) + (specifier-type (type-specifier (primitive-type-type value))))) + *backend-meta-primitive-type-names*)) + +(!cold-init-forms + (maphash + (lambda (key value) + (declare (ignore key)) + (setf (primitive-type-type value) + (specifier-type (type-specifier (primitive-type-type value))))) + *backend-primitive-type-names*)) + +(!defun-from-collected-cold-init-forms !fixup-type-cold-init) \ No newline at end of file diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp index d385515..1178b6a 100644 --- a/src/compiler/generic/primtype.lisp +++ b/src/compiler/generic/primtype.lisp @@ -100,45 +100,16 @@ ;;; primitive other-pointer array types (/show0 "primtype.lisp 96") -(!def-primitive-type simple-array-nil (descriptor-reg) - :type (simple-array nil (*))) -(!def-primitive-type simple-base-string (descriptor-reg) - :type simple-base-string) -(!def-primitive-type simple-bit-vector (descriptor-reg)) -(!def-primitive-type simple-vector (descriptor-reg)) -(!def-primitive-type simple-array-unsigned-byte-2 (descriptor-reg) - :type (simple-array (unsigned-byte 2) (*))) -(!def-primitive-type simple-array-unsigned-byte-4 (descriptor-reg) - :type (simple-array (unsigned-byte 4) (*))) -(!def-primitive-type simple-array-unsigned-byte-8 (descriptor-reg) - :type (simple-array (unsigned-byte 8) (*))) -(!def-primitive-type simple-array-unsigned-byte-16 (descriptor-reg) - :type (simple-array (unsigned-byte 16) (*))) -(!def-primitive-type simple-array-unsigned-byte-32 (descriptor-reg) - :type (simple-array (unsigned-byte 32) (*))) -(!def-primitive-type simple-array-signed-byte-8 (descriptor-reg) - :type (simple-array (signed-byte 8) (*))) -(!def-primitive-type simple-array-signed-byte-16 (descriptor-reg) - :type (simple-array (signed-byte 16) (*))) -(!def-primitive-type simple-array-signed-byte-30 (descriptor-reg) - :type (simple-array (signed-byte 30) (*))) -(!def-primitive-type simple-array-signed-byte-32 (descriptor-reg) - :type (simple-array (signed-byte 32) (*))) -(!def-primitive-type simple-array-single-float (descriptor-reg) - :type (simple-array single-float (*))) -(!def-primitive-type simple-array-double-float (descriptor-reg) - :type (simple-array double-float (*))) -#!+long-float -(!def-primitive-type simple-array-long-float (descriptor-reg) - :type (simple-array long-float (*))) -(!def-primitive-type simple-array-complex-single-float (descriptor-reg) - :type (simple-array (complex single-float) (*))) -(!def-primitive-type simple-array-complex-double-float (descriptor-reg) - :type (simple-array (complex double-float) (*))) -#!+long-float -(!def-primitive-type simple-array-complex-long-float (descriptor-reg) - :type (simple-array (complex long-float) (*))) - +(macrolet ((define-simple-array-primitive-types () + `(progn + ,@(map 'list + (lambda (saetp) + `(!def-primitive-type + ,(saetp-primitive-type-name saetp) + (descriptor-reg) + :type (simple-array ,(saetp-specifier saetp) (*)))) + *specialized-array-element-type-properties*)))) + (define-simple-array-primitive-types)) ;;; Note: The complex array types are not included, 'cause it is ;;; pointless to restrict VOPs to them. @@ -161,31 +132,6 @@ (t *backend-t-primitive-type*)))) -(defvar *simple-array-primitive-types* - '((nil . simple-array-nil) - (base-char . simple-base-string) - (bit . simple-bit-vector) - ((unsigned-byte 2) . simple-array-unsigned-byte-2) - ((unsigned-byte 4) . simple-array-unsigned-byte-4) - ((unsigned-byte 8) . simple-array-unsigned-byte-8) - ((unsigned-byte 16) . simple-array-unsigned-byte-16) - ((unsigned-byte 32) . simple-array-unsigned-byte-32) - ((signed-byte 8) . simple-array-signed-byte-8) - ((signed-byte 16) . simple-array-signed-byte-16) - (fixnum . simple-array-signed-byte-30) - ((signed-byte 32) . simple-array-signed-byte-32) - (single-float . simple-array-single-float) - (double-float . simple-array-double-float) - #!+long-float (long-float . simple-array-long-float) - ((complex single-float) . simple-array-complex-single-float) - ((complex double-float) . simple-array-complex-double-float) - #!+long-float - ((complex long-float) . simple-array-complex-long-float) - (t . simple-vector)) - #!+sb-doc - "An a-list for mapping simple array element types to their - corresponding primitive types.") - ;;; Return the primitive type corresponding to a type descriptor ;;; structure. The second value is true when the primitive type is ;;; exactly equivalent to the argument Lisp type. @@ -329,6 +275,9 @@ (let* ((dims (array-type-dimensions type)) (etype (array-type-specialized-element-type type)) (type-spec (type-specifier etype)) + ;; FIXME: We're _WHAT_? Testing for type equality + ;; with a specifier and #'EQUAL? *BOGGLE*. -- + ;; CSR, 2003-06-24 (ptype (cdr (assoc type-spec *simple-array-primitive-types* :test #'equal)))) (if (and (consp dims) (null (rest dims)) ptype) diff --git a/src/compiler/generic/vm-array.lisp b/src/compiler/generic/vm-array.lisp new file mode 100644 index 0000000..75e016f --- /dev/null +++ b/src/compiler/generic/vm-array.lisp @@ -0,0 +1,115 @@ +;;;; 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. # or + ;; # + (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.") diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index 9c50878..3bec6e1 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -14,10 +14,6 @@ (in-package "SB!KERNEL") -(/show0 "vm-type.lisp 17") - -(!begin-collecting-cold-init-forms) - ;;;; FIXME: I'm not sure where to put this. -- WHN 19990817 (deftype sb!vm:word () `(unsigned-byte ,sb!vm:n-word-bits)) @@ -78,29 +74,6 @@ ;;;; hooks into the type system -;;; the kinds of specialized array that actually exist in this implementation -(defvar *specialized-array-element-types*) -(!cold-init-forms - (setf *specialized-array-element-types* - '(nil - bit - (unsigned-byte 2) - (unsigned-byte 4) - (unsigned-byte 8) - (unsigned-byte 16) - (unsigned-byte 32) - (signed-byte 8) - (signed-byte 16) - (signed-byte 30) - (signed-byte 32) - (complex single-float) - (complex double-float) - #!+long-float (complex long-float) - base-char - single-float - double-float - #!+long-float long-float))) - (sb!xc:deftype unboxed-array (&optional dims) (collect ((types (list 'or))) (dolist (type *specialized-array-element-types*) @@ -186,7 +159,3 @@ 'sb!c:check-fun) (t nil))) - -(!defun-from-collected-cold-init-forms !vm-type-cold-init) - -(/show0 "vm-type.lisp end of file") diff --git a/src/compiler/vmdef.lisp b/src/compiler/vmdef.lisp index 75e2ff2..0c4fd38 100644 --- a/src/compiler/vmdef.lisp +++ b/src/compiler/vmdef.lisp @@ -199,7 +199,7 @@ #'<= :key #'template-cost)) -;;; Return a function type specifier describing Template's type computed +;;; Return a function type specifier describing TEMPLATE's type computed ;;; from the operand type restrictions. (defun template-type-specifier (template) (declare (type template template)) diff --git a/version.lisp-expr b/version.lisp-expr index 577fda0..7823fa0 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.0.78.vector-nil-string.6" +"0.8.0.78.vector-nil-string.7"