X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-type.lisp;h=a900222c2a43962ea064936c236e34b12e6e33f7;hb=7646aefa188758e2892fea2ad02be4f29b3938f2;hp=65561c9877856468531519ad57426bf872da1a5d;hpb=d40a76606c86722b0aef8179155f9f2840739b72;p=sbcl.git

diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index 65561c9..a900222 100644
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -14,19 +14,15 @@
 
 (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))
 
 ;;;; implementation-dependent DEFTYPEs
 
-;;; Make DOUBLE-FLOAT a synonym for LONG-FLOAT, SINGLE-FLOAT for SHORT-FLOAT.
-;;; This is expanded before the translator gets a chance, so we will get
-;;; precedence.
+;;; Make DOUBLE-FLOAT a synonym for LONG-FLOAT, SINGLE-FLOAT for
+;;; SHORT-FLOAT. This is expanded before the translator gets a chance,
+;;; so we will get precedence.
 #!-long-float
 (setf (info :type :kind 'long-float) :defined)
 #!-long-float
@@ -37,7 +33,7 @@
   `(single-float ,low ,high))
 
 ;;; an index into an integer
-(sb!xc:deftype bit-index () `(integer 0 ,most-positive-fixnum))
+(sb!xc:deftype bit-index () `(integer 0 ,sb!xc:most-positive-fixnum))
 
 ;;; worst-case values for float attributes
 (sb!xc:deftype float-exponent ()
@@ -47,6 +43,9 @@
   #!-long-float `(integer 0 ,sb!vm:double-float-digits)
   #!+long-float `(integer 0 ,sb!vm:long-float-digits))
 (sb!xc:deftype float-radix () '(integer 2 2))
+(sb!xc:deftype float-int-exponent ()
+  #!-long-float 'double-float-int-exponent
+  #!+long-float 'long-float-int-exponent)
 
 ;;; a code for BOOLE
 (sb!xc:deftype boole-code () '(unsigned-byte 4))
@@ -78,28 +77,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*
-	'(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*)
@@ -130,7 +107,12 @@
 (defun specialize-array-type (type)
   (let ((eltype (array-type-element-type type)))
     (setf (array-type-specialized-element-type type)
-	  (if (eq eltype *wild-type*)
+	  (if (or (eq eltype *wild-type*)
+		  ;; This is slightly dubious, but not as dubious as
+		  ;; assuming that the upgraded-element-type should be
+		  ;; equal to T, given the way that the AREF
+		  ;; DERIVE-TYPE optimizer works.  -- CSR, 2002-08-19
+		  (unknown-type-p eltype))
 	      *wild-type*
 	      (dolist (stype-name *specialized-array-element-types*
 				  *universal-type*)
@@ -140,10 +122,21 @@
 		;; them on the fly this way? (Call the new array
 		;; *SPECIALIZED-ARRAY-ELEMENT-SPECIFIER-TYPES* or something..)
 		(let ((stype (specifier-type stype-name)))
+		  (aver (not (unknown-type-p stype)))
 		  (when (csubtypep eltype stype)
 		    (return stype))))))
     type))
 
+(defun sb!xc:upgraded-array-element-type (spec &optional environment)
+  #!+sb-doc
+  "Return the element type that will actually be used to implement an array
+   with the specifier :ELEMENT-TYPE Spec."
+  (declare (ignore environment))
+  (if (unknown-type-p (specifier-type spec))
+      (error "undefined type: ~S" spec)
+      (type-specifier (array-type-specialized-element-type
+		       (specifier-type `(array ,spec))))))
+
 ;;; Return the most specific integer type that can be quickly checked that
 ;;; includes the given type.
 (defun containing-integer-type (subtype)
@@ -164,7 +157,7 @@
      (if (type= type (specifier-type 'cons))
 	 'sb!c:check-cons
 	 nil))
-    (built-in-class
+    (built-in-classoid
      (if (type= type (specifier-type 'symbol))
 	 'sb!c:check-symbol
 	 nil))
@@ -180,7 +173,3 @@
      'sb!c:check-fun)
     (t
      nil)))
-
-(!defun-from-collected-cold-init-forms !vm-type-cold-init)
-
-(/show0 "vm-type.lisp end of file")