;;; primitive integer types that fit in registers
(/show0 "primtype.lisp 24")
(!def-primitive-type positive-fixnum (any-reg signed-reg unsigned-reg)
- :type (unsigned-byte 29))
+ :type (unsigned-byte #.sb!vm:n-positive-fixnum-bits))
(/show0 "primtype.lisp 27")
#!-alpha
(!def-primitive-type unsigned-byte-31 (signed-reg unsigned-reg descriptor-reg)
(!def-primitive-type unsigned-byte-64 (unsigned-reg descriptor-reg)
:type (unsigned-byte 64))
(!def-primitive-type fixnum (any-reg signed-reg)
- :type (signed-byte 30))
+ :type (signed-byte #.(1+ sb!vm:n-positive-fixnum-bits)))
#!-alpha
(!def-primitive-type signed-byte-32 (signed-reg descriptor-reg)
:type (signed-byte 32))
;;; other primitive immediate types
(/show0 "primtype.lisp 68")
-(!def-primitive-type base-char (base-char-reg any-reg))
+(!def-primitive-type character (character-reg any-reg))
;;; primitive pointer types
(/show0 "primtype.lisp 73")
(!def-primitive-type single-float (single-reg descriptor-reg))
(/show0 "about to !DEF-PRIMITIVE-TYPE DOUBLE-FLOAT")
(!def-primitive-type double-float (double-reg descriptor-reg))
-#!+long-float
-(!def-primitive-type long-float (long-reg descriptor-reg))
+
(/show0 "about to !DEF-PRIMITIVE-TYPE COMPLEX-SINGLE-FLOAT")
(!def-primitive-type complex-single-float (complex-single-reg descriptor-reg)
:type (complex single-float))
(/show0 "about to !DEF-PRIMITIVE-TYPE COMPLEX-DOUBLE-FLOAT")
(!def-primitive-type complex-double-float (complex-double-reg descriptor-reg)
:type (complex double-float))
-#!+long-float
-(!def-primitive-type complex-long-float (complex-long-reg descriptor-reg)
- :type (complex long-float))
+
;;; 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-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) (*)))
-
-;;; Note: The complex array types are not included, 'cause it is pointless to
-;;; restrict VOPs to them.
+(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.
;;; other primitive other-pointer types
(!def-primitive-type system-area-pointer (sap-reg descriptor-reg))
\f
;;;; PRIMITIVE-TYPE-OF and friends
-;;; Return the most restrictive primitive type that contains Object.
+;;; Return the most restrictive primitive type that contains OBJECT.
(/show0 "primtype.lisp 147")
(!def-vm-support-routine primitive-type-of (object)
(let ((type (ctype-of object)))
(t
*backend-t-primitive-type*))))
-(defvar *simple-array-primitive-types*
- '((nil . simple-array-nil)
- (base-char . simple-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.
(integer
(cond ((and hi lo)
(dolist (spec
- `((positive-fixnum 0 ,(1- (ash 1 29)))
+ `((positive-fixnum 0 ,sb!xc:most-positive-fixnum)
#!-alpha
(unsigned-byte-31 0 ,(1- (ash 1 31)))
#!-alpha
(unsigned-byte-63 0 ,(1- (ash 1 63)))
#!+alpha
(unsigned-byte-64 0 ,(1- (ash 1 64)))
- (fixnum ,(ash -1 29)
- ,(1- (ash 1 29)))
+ (fixnum ,sb!xc:most-negative-fixnum
+ ,sb!xc:most-positive-fixnum)
#!-alpha
(signed-byte-32 ,(ash -1 31)
,(1- (ash 1 31)))
#!+alpha
(signed-byte-64 ,(ash -1 63)
,(1- (ash 1 63))))
- (if (or (< hi (ash -1 29))
- (> lo (1- (ash 1 29))))
+ (if (or (< hi sb!xc:most-negative-fixnum)
+ (> lo sb!xc:most-positive-fixnum))
(part-of bignum)
(any)))
(let ((type (car spec))
(return (values
(primitive-type-or-lose type)
(and (= lo min) (= hi max))))))))
- ((or (and hi (< hi most-negative-fixnum))
- (and lo (> lo most-positive-fixnum)))
+ ((or (and hi (< hi sb!xc:most-negative-fixnum))
+ (and lo (> lo sb!xc:most-positive-fixnum)))
(part-of bignum))
(t
(any))))
((short-float single-float)
(values (primitive-type-or-lose 'single-float)
exact))
- ((double-float #!-long-float long-float)
+ ((double-float)
(values (primitive-type-or-lose 'double-float)
exact))
- #!+long-float
- (long-float
- (values (primitive-type-or-lose 'long-float)
- exact))
(t
(any)))))
(t
((short-float single-float)
(values (primitive-type-or-lose 'complex-single-float)
exact))
- ((double-float #!-long-float long-float)
+ ((double-float long-float)
(values (primitive-type-or-lose 'complex-double-float)
exact))
- #!+long-float
- (long-float
- (values (primitive-type-or-lose 'complex-long-float)
- exact))
(t
(part-of complex))))
(part-of complex)))
(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)
(values (primitive-type-or-lose (classoid-name type)) t))
(funcallable-instance
(part-of function))
- (base-char
- (exactly base-char))
+ (character
+ (exactly character))
(cons-type
(part-of list))
(t
projects / sbcl.git / blobdiff