X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=05bee480996090406bb9a7f0f965da063925c30b;hb=ebf2239bc0f2e306ed98acaef232fce9c8f1d5d2;hp=c80c5a0157efeaca80fb8fc94bb1977ba3b12b87;hpb=7c07a6f965c51828d8f452b47e0620d8e6cf2959;p=sbcl.git

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index c80c5a0..05bee48 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -84,8 +84,7 @@
 (defun primify (x)
   (declare (type unsigned-byte x))
   (do ((n (logior x 1) (+ n 2)))
-      ((sb!sys:positive-primep n)
-       n)))
+      ((positive-primep n) n)))
 
 ;;;; info classes, info types, and type numbers, part I: what's needed
 ;;;; not only at compile time but also at run time
@@ -100,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
@@ -153,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
@@ -265,24 +265,22 @@
 ;;; cold load time.
 (defparameter *reversed-type-info-init-forms* nil)
 
+;;; Define a new type of global information for CLASS. TYPE is the
+;;; name of the type, DEFAULT is the value for that type when it
+;;; hasn't been set, and TYPE-SPEC is a type specifier which values of
+;;; the type must satisfy. The default expression is evaluated each
+;;; time the information is needed, with NAME bound to the name for
+;;; which the information is being looked up. 
+;;;
 ;;; The main thing we do is determine the type's number. We need to do
 ;;; this at macroexpansion time, since both the COMPILE and LOAD time
 ;;; 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)
-  #!+sb-doc
-  "Define-Info-Type Class Type default Type-Spec
-  Define a new type of global information for Class. Type is the name
-  of the type, Default is the value for that type when it hasn't been set, and
-  Type-Spec is a type-specifier which values of the type must satisfy. The
-  default expression is evaluated each time the information is needed, with
-  Name bound to the name for which the information is being looked up. If the
-  default evaluates to something with the second value true, then the second
-  value of Info will also be true."
   (declare (type keyword class type))
   `(progn
      (eval-when (:compile-toplevel :execute)
@@ -338,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)))
@@ -362,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
@@ -482,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
@@ -503,27 +501,26 @@
   (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)
-  ;; 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 (*))))
-
-(defconstant compact-info-entry-type-mask (ldb (byte type-number-bits 0) -1))
-(defconstant 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.
+  (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 (missing-arg) :type (simple-array compact-info-entry (*))))
+
+(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.
 #!-sb-fluid (declaim (inline compact-info-cache-hit))
 (defun compact-info-cache-hit (env number)
   (declare (type compact-info-env env) (type type-number number))
@@ -541,10 +538,23 @@
 	      (return (values nil nil)))))
 	(values nil nil))))
 
-;;; Encache Name in the compact environment Env. Hash is the
-;;; GLOBALDB-SXHASHOID of Name.
+;;; Encache NAME in the compact environment ENV. HASH is the
+;;; GLOBALDB-SXHASHOID of NAME.
 (defun compact-info-lookup (env name hash)
-  (declare (type compact-info-env env) (type index hash))
+  (declare (type compact-info-env env)
+	   ;; FIXME: this used to read (TYPE INDEX HASH), but that was
+	   ;; wrong, because HASH was a positive fixnum, not a (MOD
+	   ;; MOST-POSITIVE-FIXNUM).
+	   ;;
+	   ;; However, this, its replacement, is also wrong.  In the
+	   ;; cross-compiler, GLOBALDB-SXHASHOID is essentially
+	   ;; SXHASH.  But our host compiler could have any value at
+	   ;; all as its MOST-POSITIVE-FIXNUM, and so could in
+	   ;; principle return a value exceeding our target positive
+	   ;; fixnum range.
+	   ;;
+	   ;; My brain hurts.  -- CSR, 2003-08-28
+	   (type (integer 0 #.sb!xc:most-positive-fixnum) hash))
   (let* ((table (compact-info-env-table env))
 	 (len (length table))
 	 (len-2 (- len 2))
@@ -554,7 +564,7 @@
 		 `(do ((probe (rem hash len)
 			      (let ((new (+ probe hash2)))
 				(declare (type index new))
-				;; same as (mod new len), but faster.
+				;; same as (MOD NEW LEN), but faster.
 				(if (>= new len)
 				    (the index (- new len))
 				    new))))
@@ -575,7 +585,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.
@@ -689,7 +699,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)
@@ -706,7 +716,9 @@
 
 ;;; Just like COMPACT-INFO-LOOKUP, only do it on a volatile environment.
 (defun volatile-info-lookup (env name hash)
-  (declare (type volatile-info-env env) (type index hash))
+  (declare (type volatile-info-env env)
+	   ;; FIXME: see comment in COMPACT-INFO-LOOKUP
+	   (type (integer 0 #.sb!xc:most-positive-fixnum) hash))
   (let ((table (volatile-info-env-table env)))
     (macrolet ((lookup (test)
 		 `(dolist (entry (svref table (mod hash (length table))) ())
@@ -717,11 +729,10 @@
 		(lookup eq)
 		(lookup equal)))
       (setf (volatile-info-env-cache-name env) name)))
-
   (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
@@ -820,13 +831,16 @@
 (define-compiler-macro info
   (&whole whole class type name &optional (env-list nil env-list-p))
   ;; Constant CLASS and TYPE is an overwhelmingly common special case,
-  ;; and we can resolve it much more efficiently than the general 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)))
-	`(the ,(type-info-type info)
-	   (get-info-value ,name
-			   ,(type-info-number info)
-			   ,@(when env-list-p `(,env-list)))))
+	(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
@@ -836,13 +850,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.
@@ -881,7 +895,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"))
@@ -1023,7 +1037,7 @@
   :default
   #+sb-xc-host (specifier-type 'function)
   #-sb-xc-host (if (fboundp name)
-		   (extract-function-type (fdefinition name))
+		   (extract-fun-type (fdefinition name))
 		   (specifier-type 'function)))
 
 ;;; the ASSUMED-TYPE for this function, if we have to infer the type
@@ -1032,10 +1046,10 @@
   :class :function
   :type :assumed-type
   ;; FIXME: The type-spec really should be
-  ;;   (or approximate-function-type null)).
+  ;;   (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
@@ -1056,11 +1070,31 @@
   #+sb-xc-host :assumed
   #-sb-xc-host (if (fboundp name) :defined :assumed))
 
-;;; lambda used for inline expansion of this function
+;;; something which can be decoded into the inline expansion of the
+;;; function, or NIL if there is none
+;;;
+;;; To inline a function, we want a lambda expression, e.g.
+;;; '(LAMBDA (X) (+ X 1)). That can be encoded here in one of two
+;;; ways.
+;;;   * The value in INFO can be the lambda expression itself, e.g. 
+;;;       (SETF (INFO :FUNCTION :INLINE-EXPANSION-DESIGNATOR 'FOO)
+;;;             '(LAMBDA (X) (+ X 1)))
+;;;     This is the ordinary way, the natural way of representing e.g.
+;;;       (DECLAIM (INLINE FOO))
+;;;       (DEFUN FOO (X) (+ X 1))
+;;;   * The value in INFO can be a closure which returns the lambda
+;;;     expression, e.g.
+;;;       (SETF (INFO :FUNCTION :INLINE-EXPANSION-DESIGNATOR 'BAR-LEFT-CHILD)
+;;;             (LAMBDA ()
+;;;               '(LAMBDA (BAR) (BAR-REF BAR 3))))
+;;;     This twisty way of storing values is supported in order to
+;;;     allow structure slot accessors, and perhaps later other
+;;;     stereotyped functions, to be represented compactly.
 (define-info-type
   :class :function
-  :type :inline-expansion
-  :type-spec list)
+  :type :inline-expansion-designator
+  :type-spec (or list function)
+  :default nil)
 
 ;;; This specifies whether this function may be expanded inline. If
 ;;; null, we don't care.
@@ -1098,28 +1132,12 @@
   :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 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
@@ -1131,7 +1149,7 @@
 (define-info-type
   :class :function
   :type :definition
-  :type-spec t
+  :type-spec (or fdefn null)
   :default nil)
 
 ;;;; definitions for other miscellaneous information
@@ -1142,11 +1160,10 @@
 (define-info-type
   :class :variable
   :type :kind
-  :type-spec (member :special :constant :global :alien)
-  :default (if (or (eq (symbol-package name) *keyword-package*)
-		   (member name '(t nil)))
-	     :constant
-	     :global))
+  :type-spec (member :special :constant :macro :global :alien)
+  :default (if (symbol-self-evaluating-p name)
+	       :constant
+	       :global))
 
 ;;; the declared type for this variable
 (define-info-type
@@ -1167,9 +1184,23 @@
   :class :variable
   :type :constant-value
   :type-spec t
-  :default (if (boundp name)
-	     (values (symbol-value name) t)
-	     (values nil nil)))
+  ;; CMU CL used to return two values for (INFO :VARIABLE :CONSTANT-VALUE ..).
+  ;; Now we don't: it was the last remaining multiple-value return from
+  ;; the INFO system, and bringing it down to one value lets us simplify
+  ;; things, especially simplifying the declaration of return types.
+  ;; Software which used to check the second value (for "is it defined
+  ;; as a constant?") should check (EQL (INFO :VARIABLE :KIND ..) :CONSTANT)
+  ;; instead.
+  :default (if (symbol-self-evaluating-p name)
+	       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
@@ -1186,11 +1217,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
@@ -1227,12 +1261,12 @@
 ;;; 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
-  :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
@@ -1240,8 +1274,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