X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=8a7a6ef6495ffbb51b93f18ce652c6e038f0428d;hb=05525d3a5906d7a89fcb689c26177732493c40ce;hp=88e397110f1675b8f6fdb73823b7ad436e728a41;hpb=8731c1a7c1a585d190151fa881050fb5e14c0616;p=sbcl.git

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 88e3971..8a7a6ef 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -360,7 +360,7 @@
 	     ,(do-compact-info name class type type-number value
 			       n-env body)))))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
 
 ;;; Return code to iterate over a compact info environment.
 (defun do-compact-info (name-var class-var type-var type-number-var value-var
@@ -717,8 +717,8 @@
 
   (values))
 
-;;; Given a volatile environment Env, bind Table-Var the environment's table
-;;; and Index-Var to the index of Name's bucket in the table. We also flush
+;;; Given a volatile environment ENV, bind TABLE-VAR the environment's table
+;;; and INDEX-VAR to the index of NAME's bucket in the table. We also flush
 ;;; the cache so that things will be consistent if body modifies something.
 (eval-when (:compile-toplevel :execute)
   (#+sb-xc-host cl:defmacro
@@ -819,15 +819,14 @@
   ;; Constant CLASS and TYPE is an overwhelmingly common special case,
   ;; and we can implement it much more efficiently than the general case.
   (if (and (constantp class) (constantp type))
-      (let ((info (type-info-or-lose class type))
-	    (value (gensym "VALUE"))
-	    (foundp (gensym "FOUNDP")))
-	`(multiple-value-bind (,value ,foundp)
-	     (get-info-value ,name
-			     ,(type-info-number info)
-			     ,@(when env-list-p `(,env-list))) 
-	   (declare (type ,(type-info-type info) ,value))
-	   (values ,value ,foundp)))
+      (let ((info (type-info-or-lose class type)))
+	(with-unique-names (value foundp)
+	  `(multiple-value-bind (,value ,foundp)
+	       (get-info-value ,name
+			       ,(type-info-number info)
+			       ,@(when env-list-p `(,env-list))) 
+	     (declare (type ,(type-info-type info) ,value))
+	     (values ,value ,foundp))))
       whole))
 (defun (setf info) (new-value
 		    class
@@ -837,13 +836,13 @@
   (let* ((info (type-info-or-lose class type))
 	 (tin (type-info-number info)))
     (if env-list-p
-      (set-info-value name
-		      tin
-		      new-value
-		      (get-write-info-env env-list))
-      (set-info-value name
-		      tin
-		      new-value)))
+	(set-info-value name
+			tin
+			new-value
+			(get-write-info-env env-list))
+	(set-info-value name
+			tin
+			new-value)))
   new-value)
 ;;; FIXME: We'd like to do this, but Python doesn't support
 ;;; compiler macros and it's hard to change it so that it does.
@@ -1036,7 +1035,7 @@
   ;;   (or approximate-fun-type null)).
   ;; It was changed to T as a hopefully-temporary hack while getting
   ;; cold init problems untangled.
-  :type-spec t) 
+  :type-spec t)
 
 ;;; where this information came from:
 ;;;    :ASSUMED  = from uses of the object
@@ -1119,13 +1118,6 @@
   :type :ir1-convert
   :type-spec (or function null))
 
-;;; a function which gets a chance to do stuff to the IR1 for any call
-;;; to this function.
-(define-info-type
-  :class :function
-  :type :ir1-transform
-  :type-spec (or function null))
-
 ;;; If a function is "known" to the compiler, then this is a FUN-INFO
 ;;; structure containing the info used to special-case compilation.
 (define-info-type
@@ -1143,7 +1135,7 @@
 (define-info-type
   :class :function
   :type :definition
-  :type-spec t
+  :type-spec (or fdefn null)
   :default nil)
 
 ;;;; definitions for other miscellaneous information
@@ -1259,8 +1251,8 @@
 ;;; meaningful error if we only have the cons.
 (define-info-type
   :class :type
-  :type :class
-  :type-spec (or sb!kernel::class-cell null)
+  :type :classoid
+  :type-spec (or sb!kernel::classoid-cell null)
   :default nil)
 
 ;;; layout for this type being used by the compiler
@@ -1268,8 +1260,8 @@
   :class :type
   :type :compiler-layout
   :type-spec (or layout null)
-  :default (let ((class (sb!xc:find-class name nil)))
-	     (when class (class-layout class))))
+  :default (let ((class (find-classoid name nil)))
+	     (when class (classoid-layout class))))
 
 (define-info-class :typed-structure)
 (define-info-type