X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=88e397110f1675b8f6fdb73823b7ad436e728a41;hb=7f0f521aa3f6b45259c5dfd5f7f11adcd1a7cac6;hp=f586c1084b2644394b77eadf3e27e5af1d751e98;hpb=0a82f2db352cc348d2107a882e50af222ff97ed3;p=sbcl.git

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index f586c10..88e3971 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -99,7 +99,8 @@
 
 ;;; At run time, we represent the type of info that we want by a small
 ;;; non-negative integer.
-(defconstant type-number-bits 6)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (def!constant type-number-bits 6))
 (deftype type-number () `(unsigned-byte ,type-number-bits))
 
 ;;; Why do we suppress the :COMPILE-TOPLEVEL situation here when we're
@@ -152,17 +153,17 @@
 	    (:print-object (lambda (x s)
 			     (print-unreadable-object (x s)
 			       (format s
-				       "~S ~S, Number = ~D"
+				       "~S ~S, Number = ~W"
 				       (class-info-name (type-info-class x))
 				       (type-info-name x)
 				       (type-info-number x)))))
 	    (:copier nil))
   ;; the name of this type
-  (name (required-argument) :type keyword)
+  (name (missing-arg) :type keyword)
   ;; this type's class
-  (class (required-argument) :type class-info)
+  (class (missing-arg) :type class-info)
   ;; a number that uniquely identifies this type (and implicitly its class)
-  (number (required-argument) :type type-number)
+  (number (missing-arg) :type type-number)
   ;; a type specifier which info of this type must satisfy
   (type nil :type t)
   ;; a function called when there is no information of this type
@@ -276,9 +277,9 @@
 ;;; calls to %DEFINE-INFO-TYPE must use the same type number.
 (#+sb-xc-host defmacro
  #-sb-xc-host sb!xc:defmacro
-    define-info-type (&key (class (required-argument))
-			   (type (required-argument))
-			   (type-spec (required-argument))
+    define-info-type (&key (class (missing-arg))
+			   (type (missing-arg))
+			   (type-spec (missing-arg))
 			   default)
   (declare (type keyword class type))
   `(progn
@@ -335,7 +336,7 @@
 		     (:copier nil))
   ;; some string describing what is in this environment, for
   ;; printing/debugging purposes only
-  (name (required-argument) :type string))
+  (name (missing-arg) :type string))
 (def!method print-object ((x info-env) stream)
   (print-unreadable-object (x stream :type t)
     (prin1 (info-env-name x) stream)))
@@ -479,7 +480,7 @@
 ;;;; compact info environments
 
 ;;; The upper limit on the size of the ENTRIES vector in a COMPACT-INFO-ENV.
-(defconstant compact-info-env-entries-bits 16)
+(def!constant compact-info-env-entries-bits 16)
 (deftype compact-info-entries-index () `(unsigned-byte ,compact-info-env-entries-bits))
 
 ;;; the type of the values in COMPACT-INFO-ENTRIES-INFO
@@ -500,25 +501,23 @@
   (cache-index nil :type (or compact-info-entries-index null))
   ;; hashtable of the names in this environment. If a bucket is
   ;; unused, it is 0.
-  (table (required-argument) :type simple-vector)
+  (table (missing-arg) :type simple-vector)
   ;; an indirection vector parallel to TABLE, translating indices in
   ;; TABLE to the start of the ENTRIES for that name. Unused entries
   ;; are undefined.
-  (index (required-argument)
-	 :type (simple-array compact-info-entries-index (*)))
+  (index (missing-arg) :type (simple-array compact-info-entries-index (*)))
   ;; a vector contining in contiguous ranges the values of for all the
   ;; types of info for each name.
-  (entries (required-argument) :type simple-vector)
+  (entries (missing-arg) :type simple-vector)
   ;; a vector parallel to ENTRIES, indicating the type number for the
   ;; value stored in that location and whether this location is the
   ;; last type of info stored for this name. The type number is in the
   ;; low TYPE-NUMBER-BITS bits, and the next bit is set if this is the
   ;; last entry.
-  (entries-info (required-argument)
-		:type (simple-array compact-info-entry (*))))
+  (entries-info (missing-arg) :type (simple-array compact-info-entry (*))))
 
-(defconstant compact-info-entry-type-mask (ldb (byte type-number-bits 0) -1))
-(defconstant compact-info-entry-last (ash 1 type-number-bits))
+(def!constant compact-info-entry-type-mask (ldb (byte type-number-bits 0) -1))
+(def!constant compact-info-entry-last (ash 1 type-number-bits))
 
 ;;; Return the value of the type corresponding to NUMBER for the
 ;;; currently cached name in ENV.
@@ -573,7 +572,7 @@
 
 ;;; the exact density (modulo rounding) of the hashtable in a compact
 ;;; info environment in names/bucket
-(defconstant compact-info-environment-density 65)
+(def!constant compact-info-environment-density 65)
 
 ;;; Return a new compact info environment that holds the same
 ;;; information as ENV.
@@ -687,7 +686,7 @@
   (cache-types nil :type list)
   ;; vector of alists of alists of the form:
   ;;    ((Name . ((Type-Number . Value) ...) ...)
-  (table (required-argument) :type simple-vector)
+  (table (missing-arg) :type simple-vector)
   ;; the number of distinct names currently in this table. Each name
   ;; may have multiple entries, since there can be many types of info.
   (count 0 :type index)
@@ -827,8 +826,8 @@
 	     (get-info-value ,name
 			     ,(type-info-number info)
 			     ,@(when env-list-p `(,env-list))) 
-	   (values (the ,(type-info-type info) ,value)
-		   ,foundp)))
+	   (declare (type ,(type-info-type info) ,value))
+	   (values ,value ,foundp)))
       whole))
 (defun (setf info) (new-value
 		    class
@@ -883,7 +882,7 @@
 ;;;
 ;;; FIXME: actually seems to be measured in percent, should be
 ;;; converted to be measured in names/bucket
-(defconstant volatile-info-environment-density 50)
+(def!constant volatile-info-environment-density 50)
 
 ;;; Make a new volatile environment of the specified size.
 (defun make-info-environment (&key (size 42) (name "Unknown"))
@@ -1083,14 +1082,6 @@
   :type :inline-expansion-designator
   :type-spec (or list function)
   :default nil)
-;;; Decode any raw (INFO :FUNCTION :INLINE-EXPANSION-DESIGNATOR FUN-NAME)
-;;; value into a lambda expression, or return NIL if there is none.
-(declaim (ftype (function ((or symbol cons)) list) fun-name-inline-expansion))
-(defun fun-name-inline-expansion (fun-name)
-  (let ((info (info :function :inline-expansion-designator fun-name)))
-    (if (functionp info)
-	(funcall info)
-	info)))
 
 ;;; This specifies whether this function may be expanded inline. If
 ;;; null, we don't care.
@@ -1135,21 +1126,12 @@
   :type :ir1-transform
   :type-spec (or function null))
 
-;;; If a function is a slot accessor or setter, then this is the class
-;;; that it accesses slots of.
-(define-info-type
-  :class :function
-  :type :accessor-for
-  :type-spec (or sb!xc:class null)
-  :default nil)
-
-;;; If a function is "known" to the compiler, then this is a
-;;; FUNCTION-INFO structure containing the info used to special-case
-;;; compilation.
+;;; 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
   :class :function
   :type :info
-  :type-spec (or function-info null)
+  :type-spec (or fun-info null)
   :default nil)
 
 (define-info-type
@@ -1172,7 +1154,7 @@
 (define-info-type
   :class :variable
   :type :kind
-  :type-spec (member :special :constant :global :alien)
+  :type-spec (member :special :constant :macro :global :alien)
   :default (if (symbol-self-evaluating-p name)
 	       :constant
 	       :global))
@@ -1205,8 +1187,14 @@
   ;; instead.
   :default (if (symbol-self-evaluating-p name)
 	       name
-	       (error "internal error: constant lookup of nonconstant ~S"
-		      name)))
+	       (bug "constant lookup of nonconstant ~S" name)))
+
+;;; the macro-expansion for symbol-macros
+(define-info-type
+  :class :variable
+  :type :macro-expansion
+  :type-spec t
+  :default nil)
 
 (define-info-type
   :class :variable
@@ -1223,11 +1211,14 @@
 (define-info-class :type)
 
 ;;; the kind of type described. We return :INSTANCE for standard types
-;;; that are implemented as structures.
+;;; that are implemented as structures. For PCL classes, that have
+;;; only been compiled, but not loaded yet, we return
+;;; :FORTHCOMING-DEFCLASS-TYPE.
 (define-info-type
   :class :type
   :type :kind
-  :type-spec (member :primitive :defined :instance nil)
+  :type-spec (member :primitive :defined :instance
+		     :forthcoming-defclass-type nil)
   :default nil)
 
 ;;; the expander function for a defined type
@@ -1264,7 +1255,7 @@
 ;;; If this is a class name, then the value is a cons (NAME . CLASS),
 ;;; where CLASS may be null if the class hasn't been defined yet. Note
 ;;; that for built-in classes, the kind may be :PRIMITIVE and not
-;;; :INSTANCE. The the name is in the cons so that we can signal a
+;;; :INSTANCE. The name is in the cons so that we can signal a
 ;;; meaningful error if we only have the cons.
 (define-info-type
   :class :type