0.8.16.10:

[sbcl.git] / src / compiler / generic / primtype.lisp

diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index 1178b6a..962b22f 100644 (file)
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -23,7 +23,7 @@
 ;;; 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)
@@ -40,7 +40,7 @@
 (!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))
@@ -66,7 +66,7 @@
 
 ;;; 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")
@@ -86,17 +86,14 @@
 (!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")
@@ -200,7 +197,7 @@
                (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
@@ -209,16 +206,16 @@
                                    (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))
@@ -228,8 +225,8 @@
                              (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))))
@@ -239,13 +236,9 @@
                     ((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
@@ -257,13 +250,9 @@
                      ((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)))
@@ -315,6 +304,13 @@
         (ecase (named-type-name type)
           ((t *) (values *backend-t-primitive-type* t))
           ((nil) (any))))
+       (character-set-type
+        (let ((pairs (character-set-type-pairs type)))
+          (if (and (= (length pairs) 1)
+                   (= (caar pairs) 0)
+                   (= (cdar pairs) (1- sb!xc:char-code-limit)))
+              (exactly character)
+              (part-of character))))
        (built-in-classoid
         (case (classoid-name type)
           ((complex function instance
@@ -322,8 +318,6 @@
            (values (primitive-type-or-lose (classoid-name type)) t))
           (funcallable-instance
            (part-of function))
-          (base-char
-           (exactly base-char))
           (cons-type
            (part-of list))
           (t