X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=b0decc0481a83f8bb1bfb2c32b26213db94a177e;hb=af178240ffbda39e9c3bf584ad8ed0adcf4b6abd;hp=b27deb30c479daae3f7d9bff5a935f9ef60e1d28;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index b27deb3..b0decc0 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -31,11 +31,8 @@ ;;; FIXME: centralize (declaim (special *universal-type*)) -;;; This is sorta semantically equivalent to SXHASH, but optimized for legal -;;; function names. Note: semantically equivalent does *not* mean that it -;;; always returns the same value as SXHASH, just that it satisfies the formal -;;; definition of SXHASH. The ``sorta'' is because SYMBOL-HASH will not -;;; necessarily return the same value in different lisp images. +;;; This is sorta semantically equivalent to SXHASH, but optimized for +;;; legal function names. ;;; ;;; Why optimize? We want to avoid the fully-general TYPECASE in ordinary ;;; SXHASH, because @@ -54,57 +51,66 @@ ;;; to hold all manner of things, e.g. (INFO :TYPE :BUILTIN ..) ;;; which is called on values like (UNSIGNED-BYTE 29). Falling through ;;; to SXHASH lets us support all manner of things (as long as they -;;; aren't used too early in cold boot). +;;; aren't used too early in cold boot for SXHASH to run). #!-sb-fluid (declaim (inline globaldb-sxhashoid)) (defun globaldb-sxhashoid (x) - (cond #-sb-xc-host ; (SYMBOL-HASH doesn't exist on cross-compilation host.) - ((symbolp x) - (symbol-hash x)) - #-sb-xc-host ; (SYMBOL-HASH doesn't exist on cross-compilation host.) - ((and (listp x) - (eq (first x) 'setf) - (let ((rest (rest x))) - (and (symbolp (car rest)) - (null (cdr rest))))) - (logxor (symbol-hash (second x)) - 110680597)) - (t (sxhash x)))) + (logand sb!xc:most-positive-fixnum + (cond ((symbolp x) (sxhash x)) + ((and (listp x) + (eq (first x) 'setf) + (let ((rest (rest x))) + (and (symbolp (car rest)) + (null (cdr rest))))) + ;; We need to declare the type of the value we're feeding to + ;; SXHASH so that the DEFTRANSFORM on symbols kicks in. + (let ((symbol (second x))) + (declare (symbol symbol)) + (logxor (sxhash symbol) 110680597))) + (t (sxhash x))))) ;;; Given any non-negative integer, return a prime number >= to it. ;;; -;;; FIXME: This logic should be shared with ALMOST-PRIMIFY in hash-table.lisp. -;;; Perhaps the merged logic should be PRIMIFY-HASH-TABLE-SIZE, implemented as -;;; a lookup table of primes after integral powers of two: +;;; FIXME: This logic should be shared with ALMOST-PRIMIFY in +;;; hash-table.lisp. Perhaps the merged logic should be +;;; PRIMIFY-HASH-TABLE-SIZE, implemented as a lookup table of primes +;;; after integral powers of two: ;;; #(17 37 67 131 ..) -;;; (Or, if that's too coarse, after half-integral powers of two.) By thus -;;; getting rid of any need for primality testing at runtime, we could -;;; punt POSITIVE-PRIMEP, too. +;;; (Or, if that's too coarse, after half-integral powers of two.) By +;;; thus getting rid of any need for primality testing at runtime, we +;;; could punt POSITIVE-PRIMEP, too. (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 - -;;;; Note: This section is a blast from the past, a little trip down memory -;;;; lane to revisit the weird host/target interactions of the CMU CL build -;;;; process. Because of the way that the cross-compiler and target compiler -;;;; share stuff here, if you change anything in here, you'd be well-advised to -;;;; nuke all your fasl files and restart compilation from the very beginning -;;;; of the bootstrap process. - -;;; Why do we suppress the :COMPILE-TOPLEVEL situation here when we're running -;;; the cross-compiler? The cross-compiler (which was built from these sources) -;;; has its version of these data and functions defined in the same places we'd -;;; be defining into. We're happy with its version, since it was compiled from -;;; the same sources, so there's no point in overwriting its nice compiled -;;; version of this stuff with our interpreted version. (And any time we're -;;; *not* happy with its version, perhaps because we've been editing the -;;; sources partway through bootstrapping, tch tch, overwriting its version -;;; with our version would be unlikely to help, because that would make the -;;; cross-compiler very confused.) +;;;; info classes, info types, and type numbers, part I: what's needed +;;;; not only at compile time but also at run time + +;;;; Note: This section is a blast from the past, a little trip down +;;;; memory lane to revisit the weird host/target interactions of the +;;;; CMU CL build process. Because of the way that the cross-compiler +;;;; and target compiler share stuff here, if you change anything in +;;;; here, you'd be well-advised to nuke all your fasl files and +;;;; restart compilation from the very beginning of the bootstrap +;;;; process. + +;;; At run time, we represent the type of info that we want by a small +;;; non-negative integer. +(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 +;;; running the cross-compiler? The cross-compiler (which was built +;;; from these sources) has its version of these data and functions +;;; defined in the same places we'd be defining into. We're happy with +;;; its version, since it was compiled from the same sources, so +;;; there's no point in overwriting its nice compiled version of this +;;; stuff with our interpreted version. (And any time we're *not* +;;; happy with its version, perhaps because we've been editing the +;;; sources partway through bootstrapping, tch tch, overwriting its +;;; version with our version would be unlikely to help, because that +;;; would make the cross-compiler very confused.) (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defstruct (class-info @@ -112,25 +118,29 @@ #-no-ansi-print-object (:print-object (lambda (x s) (print-unreadable-object (x s :type t) - (prin1 (class-info-name x)))))) + (prin1 (class-info-name x))))) + (:copier nil)) ;; name of this class (name nil :type keyword :read-only t) - ;; List of Type-Info structures for each type in this class. + ;; list of Type-Info structures for each type in this class (types () :type list)) -;;; At run time, we represent the type of info that we want by a small -;;; non-negative integer. -(defconstant type-number-bits 6) -(deftype type-number () `(unsigned-byte ,type-number-bits)) - ;;; a map from type numbers to TYPE-INFO objects. There is one type ;;; number for each defined CLASS/TYPE pair. ;;; -;;; We build its value at compile time (with calls to DEFINE-INFO-TYPE), then -;;; generate code to recreate the compile time value, and arrange for that -;;; code to be called in cold load. +;;; We build its value at build-the-cross-compiler time (with calls to +;;; DEFINE-INFO-TYPE), then generate code to recreate the compile time +;;; value, and arrange for that code to be called in cold load. +;;; KLUDGE: We don't try to reset its value when cross-compiling the +;;; compiler, since that creates too many bootstrapping problems, +;;; instead just reusing the built-in-the-cross-compiler version, +;;; which is theoretically a little bit ugly but pretty safe in +;;; practice because the cross-compiler is as close to the target +;;; compiler as we can make it, i.e. identical in most ways, including +;;; this one. -- WHN 2001-08-19 (defvar *info-types*) (declaim (type simple-vector *info-types*)) +#-sb-xc ; as per KLUDGE note above (eval-when (:compile-toplevel :execute) (setf *info-types* (make-array (ash 1 type-number-bits) :initial-element nil))) @@ -140,16 +150,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)))))) + (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 @@ -160,12 +171,16 @@ ;;; We build the value for this at compile time (with calls to ;;; DEFINE-INFO-CLASS), then generate code to recreate the compile time ;;; value, and arrange for that code to be called in cold load. +;;; KLUDGE: Just as for *INFO-TYPES*, we don't try to rebuild this +;;; when cross-compiling, but instead just reuse the cross-compiler's +;;; version for the target compiler. -- WHN 2001-08-19 (defvar *info-classes*) (declaim (hash-table *info-classes*)) +#-sb-xc ; as per KLUDGE note above (eval-when (:compile-toplevel :execute) (setf *info-classes* (make-hash-table))) -;;; If Name is the name of a type in Class, then return the TYPE-INFO, +;;; If NAME is the name of a type in CLASS, then return the TYPE-INFO, ;;; otherwise NIL. (defun find-type-info (name class) (declare (type keyword name) (type class-info class)) @@ -177,17 +192,26 @@ (declaim (ftype (function (keyword) class-info) class-info-or-lose)) (defun class-info-or-lose (class) (declare (type keyword class)) - (or (gethash class *info-classes*) - (error "~S is not a defined info class." class))) + #+sb-xc (/noshow0 "entering CLASS-INFO-OR-LOSE, CLASS=..") + #+sb-xc (/nohexstr class) + (prog1 + (or (gethash class *info-classes*) + (error "~S is not a defined info class." class)) + #+sb-xc (/noshow0 "returning from CLASS-INFO-OR-LOSE"))) (declaim (ftype (function (keyword keyword) type-info) type-info-or-lose)) (defun type-info-or-lose (class type) - (or (find-type-info type (class-info-or-lose class)) - (error "~S is not a defined info type." type))) + #+sb-xc (/noshow0 "entering TYPE-INFO-OR-LOSE, CLASS,TYPE=..") + #+sb-xc (/nohexstr class) + #+sb-xc (/nohexstr type) + (prog1 + (or (find-type-info type (class-info-or-lose class)) + (error "~S is not a defined info type." type)) + #+sb-xc (/noshow0 "returning from TYPE-INFO-OR-LOSE"))) ) ; EVAL-WHEN -;;;; info classes, info types, and type numbers, part II: what's needed only at -;;;; compile time, not at run time +;;;; info classes, info types, and type numbers, part II: what's +;;;; needed only at compile time, not at run time ;;; FIXME: Perhaps this stuff (the definition of DEFINE-INFO-CLASS ;;; and the calls to it) could/should go in a separate file, @@ -195,37 +219,39 @@ (eval-when (:compile-toplevel :execute) -;;; Set up the data structures to support an info class. We make sure that -;;; the class exists at compile time so that macros can use it, but don't -;;; actually store the init function until load time so that we don't break the -;;; running compiler. +;;; Set up the data structures to support an info class. +;;; +;;; comment from CMU CL: +;;; We make sure that the class exists at compile time so that +;;; macros can use it, but we don't actually store the init function +;;; until load time so that we don't break the running compiler. +;;; KLUDGE: I don't think that's the way it is any more, but I haven't +;;; looked into it enough to write a better comment. -- WHN 2001-03-06 (#+sb-xc-host defmacro #-sb-xc-host sb!xc:defmacro define-info-class (class) - #!+sb-doc - "Define-Info-Class Class - Define a new class of global information." (declare (type keyword class)) `(progn - ;; (We don't need to evaluate this at load time, compile time is enough. - ;; There's special logic elsewhere which deals with cold load - ;; initialization by inspecting the info class data structures at compile - ;; time and generating code to recreate those data structures.) + ;; (We don't need to evaluate this at load time, compile time is + ;; enough. There's special logic elsewhere which deals with cold + ;; load initialization by inspecting the info class data + ;; structures at compile time and generating code to recreate + ;; those data structures.) (eval-when (:compile-toplevel :execute) (unless (gethash ,class *info-classes*) (setf (gethash ,class *info-classes*) (make-class-info ,class)))) ,class)) -;;; Find a type number not already in use by looking for a null entry in -;;; *INFO-TYPES*. +;;; Find a type number not already in use by looking for a null entry +;;; in *INFO-TYPES*. (defun find-unused-type-number () (or (position nil *info-types*) (error "no more INFO type numbers available"))) -;;; a list of forms for initializing the DEFAULT slots of TYPE-INFO objects, -;;; accumulated during compilation and eventually converted into a function to -;;; be called at cold load time after the appropriate TYPE-INFO objects have -;;; been created +;;; a list of forms for initializing the DEFAULT slots of TYPE-INFO +;;; objects, accumulated during compilation and eventually converted +;;; into a function to be called at cold load time after the +;;; appropriate TYPE-INFO objects have been created ;;; ;;; Note: This is quite similar to the !COLD-INIT-FORMS machinery, but ;;; we can't conveniently use the ordinary !COLD-INIT-FORMS machinery @@ -234,33 +260,32 @@ ;;; order in which the TYPE-INFO-creation forms are generated doesn't ;;; match the relative order in which the forms need to be executed at ;;; cold load time. -(defparameter *reversed-type-info-init-forms* nil) - -;;; 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. +(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) - ;; At compile time, ensure that the type number exists. It will need - ;; to be forced to exist at cold load time, too, but that's not handled - ;; here; it's handled by later code which looks at the compile time - ;; state and generates code to replicate it at cold load time. + ;; At compile time, ensure that the type number exists. It will + ;; need to be forced to exist at cold load time, too, but + ;; that's not handled here; it's handled by later code which + ;; looks at the compile time state and generates code to + ;; replicate it at cold load time. (let* ((class-info (class-info-or-lose ',class)) (old-type-info (find-type-info ',type class-info))) (unless old-type-info @@ -271,40 +296,44 @@ :number new-type-number))) (setf (aref *info-types* new-type-number) new-type-info) (push new-type-info (class-info-types class-info))))) - ;; Arrange for TYPE-INFO-DEFAULT and TYPE-INFO-TYPE to be set at cold - ;; load time. (They can't very well be set at cross-compile time, since - ;; they differ between the cross-compiler and the target. The - ;; DEFAULT slot values differ because they're compiled closures, and - ;; the TYPE slot values differ in the use of SB!XC symbols instead - ;; of CL symbols.) + ;; Arrange for TYPE-INFO-DEFAULT and TYPE-INFO-TYPE to be set + ;; at cold load time. (They can't very well be set at + ;; cross-compile time, since they differ between the + ;; cross-compiler and the target. The DEFAULT slot values + ;; differ because they're compiled closures, and the TYPE slot + ;; values differ in the use of SB!XC symbols instead of CL + ;; symbols.) (push `(let ((type-info (type-info-or-lose ,',class ,',type))) (setf (type-info-default type-info) - ;; FIXME: This code is sort of nasty. It would be - ;; cleaner if DEFAULT accepted a real function, instead - ;; of accepting a statement which will be turned into a - ;; lambda assuming that the argument name is NAME. It - ;; might even be more microefficient, too, since many - ;; DEFAULTs could be implemented as (CONSTANTLY NIL) - ;; instead of full-blown (LAMBDA (X) NIL). + ;; FIXME: This code is sort of nasty. It would + ;; be cleaner if DEFAULT accepted a real + ;; function, instead of accepting a statement + ;; which will be turned into a lambda assuming + ;; that the argument name is NAME. It might + ;; even be more microefficient, too, since many + ;; DEFAULTs could be implemented as (CONSTANTLY + ;; NIL) instead of full-blown (LAMBDA (X) NIL). (lambda (name) (declare (ignorable name)) ,',default)) (setf (type-info-type type-info) ',',type-spec)) - *reversed-type-info-init-forms*)) + *!reversed-type-info-init-forms*)) ',type)) ) ; EVAL-WHEN ;;;; generic info environments -;;; Note: the CACHE-NAME slot is deliberately not shared for bootstrapping -;;; reasons. If we access with accessors for the exact type, then the inline -;;; type check will win. If the inline check didn't win, we would try to use -;;; the type system before it was properly initialized. -(defstruct (info-env (:constructor nil)) - ;; Some string describing what is in this environment, for printing purposes - ;; only. - (name (required-argument) :type string)) +;;; Note: the CACHE-NAME slot is deliberately not shared for +;;; bootstrapping reasons. If we access with accessors for the exact +;;; type, then the inline type check will win. If the inline check +;;; didn't win, we would try to use the type system before it was +;;; properly initialized. +(defstruct (info-env (:constructor nil) + (:copier nil)) + ;; some string describing what is in this environment, for + ;; printing/debugging purposes only + (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))) @@ -328,7 +357,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 @@ -343,7 +372,7 @@ (n-info-types '*info-types*)) `(dotimes (,n-index (length ,n-table)) (declare (type index ,n-index)) - (block ,PUNT + (block ,punt (let ((,name-var (svref ,n-table ,n-index))) (unless (eql ,name-var 0) (do-anonymous ((,n-type (aref ,n-entries-index ,n-index) @@ -363,8 +392,9 @@ (declare (ignorable ,type-var ,class-var ,value-var)) ,@body - (unless (zerop (logand ,n-info compact-info-entry-last)) - (return-from ,PUNT)))))))))))))) + (unless (zerop (logand ,n-info + compact-info-entry-last)) + (return-from ,punt)))))))))))))) ;;; Return code to iterate over a volatile info environment. (defun do-volatile-info (name-var class-var type-var type-number-var value-var @@ -433,12 +463,12 @@ (defun clear-invalid-info-cache () ;; Unless the cache is valid.. (unless (eq *info-environment* *cached-info-environment*) - (;; In the target Lisp, this should be done without interrupts, but in the - ;; host Lisp when cross-compiling, we don't need to sweat it, since no - ;; affected-by-GC hashes should be used when running under the host Lisp - ;; (since that's non-portable) and since only one thread should be used - ;; when running under the host Lisp (because multiple threads are - ;; non-portable too). + (;; In the target Lisp, this should be done without interrupts, + ;; but in the host Lisp when cross-compiling, we don't need to + ;; sweat it, since no affected-by-GC hashes should be used when + ;; running under the host Lisp (since that's non-portable) and + ;; since only one thread should be used when running under the + ;; host Lisp (because multiple threads are non-portable too). #-sb-xc-host without-interrupts #+sb-xc-host progn (info-cache-clear) @@ -447,46 +477,59 @@ ;;;; 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) +;;; +;;; "Why (U-B 28)?", you might wonder. Originally this was (U-B 16), +;;; presumably to ensure that the arrays of :ELEMENT-TYPE +;;; COMPACT-INFO-ENTRIES-INDEX could use a more space-efficient representation. +;;; It turns out that a environment of of only 65536 entries is insufficient in +;;; the modern world (see message from Cyrus Harmon to sbcl-devel, "Subject: +;;; purify failure when compact-info-env-entries-bits is too small"). Using +;;; (U-B 28) instead of (U-B 29) is to avoid the need for bignum overflow +;;; checks, a probably pointless micro-optimization. Hardcoding the amount of +;;; bits instead of deriving it from SB!VM::N-WORD-BITS is done to allow +;;; use of a more efficient array representation on 64-bit platforms. +;;; -- JES, 2005-04-06 +(def!constant compact-info-env-entries-bits 28) (deftype compact-info-entries-index () `(unsigned-byte ,compact-info-env-entries-bits)) ;;; the type of the values in COMPACT-INFO-ENTRIES-INFO (deftype compact-info-entry () `(unsigned-byte ,(1+ type-number-bits))) -;;; This is an open hashtable with rehashing. Since modification is not -;;; allowed, we don't have to worry about deleted entries. We indirect through -;;; a parallel vector to find the index in the ENTRIES at which the entries for -;;; a given name starts. +;;; This is an open hashtable with rehashing. Since modification is +;;; not allowed, we don't have to worry about deleted entries. We +;;; indirect through a parallel vector to find the index in the +;;; ENTRIES at which the entries for a given name starts. (defstruct (compact-info-env (:include info-env) - #-sb-xc-host (:pure :substructure)) - ;; If this value is EQ to the name we want to look up, then the cache hit - ;; function can be called instead of the lookup function. + #-sb-xc-host (:pure :substructure) + (:copier nil)) + ;; If this value is EQ to the name we want to look up, then the + ;; cache hit function can be called instead of the lookup function. (cache-name 0) - ;; The index in ENTRIES for the CACHE-NAME, or NIL if that name has no - ;; entries. + ;; The index in ENTRIES for the CACHE-NAME, or NIL if that name has + ;; no entries. (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) - ;; 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 (*))) - ;; 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. + ;; hashtable of the names in this environment. If a bucket is + ;; unused, it is 0. + (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 (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 (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)) @@ -504,10 +547,11 @@ (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) + (type (integer 0 #.sb!xc:most-positive-fixnum) hash)) (let* ((table (compact-info-env-table env)) (len (length table)) (len-2 (- len 2)) @@ -517,7 +561,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)))) @@ -536,29 +580,31 @@ (values)) -;;; Exact density (modulo rounding) of the hashtable in a compact info -;;; environment in names/bucket. -(defconstant compact-info-environment-density 65) +;;; the exact density (modulo rounding) of the hashtable in a compact +;;; info environment in names/bucket +(def!constant compact-info-environment-density 65) -;;; Iterate over the environment once to find out how many names and entries -;;; it has, then build the result. This code assumes that all the entries for -;;; a name well be iterated over contiguously, which holds true for the -;;; implementation of iteration over both kinds of environments. -;;; -;;; When building the table, we sort the entries by POINTER< in an attempt -;;; to preserve any VM locality present in the original load order, rather than -;;; randomizing with the original hash function. +;;; Return a new compact info environment that holds the same +;;; information as ENV. (defun compact-info-environment (env &key (name (info-env-name env))) - #!+sb-doc - "Return a new compact info environment that holds the same information as - Env." (let ((name-count 0) (prev-name 0) (entry-count 0)) + (/show0 "before COLLECT in COMPACT-INFO-ENVIRONMENT") + + ;; Iterate over the environment once to find out how many names + ;; and entries it has, then build the result. This code assumes + ;; that all the entries for a name well be iterated over + ;; contiguously, which holds true for the implementation of + ;; iteration over both kinds of environments. (collect ((names)) + + (/show0 "at head of COLLECT in COMPACT-INFO-ENVIRONMENT") (let ((types ())) (do-info (env :name name :type-number num :value value) + (/noshow0 "at head of DO-INFO in COMPACT-INFO-ENVIRONMENT") (unless (eq name prev-name) + (/noshow0 "not (EQ NAME PREV-NAME) case") (incf name-count) (unless (eql prev-name 0) (names (cons prev-name types))) @@ -567,8 +613,17 @@ (incf entry-count) (push (cons num value) types)) (unless (eql prev-name 0) + (/show0 "not (EQL PREV-NAME 0) case") (names (cons prev-name types)))) + ;; Now that we know how big the environment is, we can build + ;; a table to represent it. + ;; + ;; When building the table, we sort the entries by pointer + ;; comparison in an attempt to preserve any VM locality present + ;; in the original load order, rather than randomizing with the + ;; original hash function. + (/show0 "about to make/sort vectors in COMPACT-INFO-ENVIRONMENT") (let* ((table-size (primify (+ (truncate (* name-count 100) compact-info-environment-density) @@ -581,10 +636,12 @@ :element-type 'compact-info-entry)) (sorted (sort (names) #+sb-xc-host #'< + ;; (This MAKE-FIXNUM hack implements + ;; pointer comparison, as explained above.) #-sb-xc-host (lambda (x y) - ;; FIXME: What's going on here? (< (%primitive make-fixnum x) (%primitive make-fixnum y)))))) + (/show0 "done making/sorting vectors in COMPACT-INFO-ENVIRONMENT") (let ((entries-idx 0)) (dolist (types sorted) (let* ((name (first types)) @@ -599,7 +656,7 @@ (setf (svref table probe) name) (setf (aref index probe) entries-idx) (return)) - (assert (not (equal entry name)))))) + (aver (not (equal entry name)))))) (unless (zerop entries-idx) (setf (aref entries-info (1- entries-idx)) @@ -610,12 +667,15 @@ (setf (aref entries-info entries-idx) num) (setf (aref entries entries-idx) value) (incf entries-idx))) + (/show0 "done w/ DOLIST (TYPES SORTED) in COMPACT-INFO-ENVIRONMENT") (unless (zerop entry-count) + (/show0 "nonZEROP ENTRY-COUNT") (setf (aref entries-info (1- entry-count)) (logior (aref entries-info (1- entry-count)) compact-info-entry-last))) + (/show0 "falling through to MAKE-COMPACT-INFO-ENV") (make-compact-info-env :name name :table table :index index @@ -624,22 +684,23 @@ ;;;; volatile environments -;;; This is a closed hashtable, with the bucket being computed by taking the -;;; GLOBALDB-SXHASHOID of the Name mod the table size. -(defstruct (volatile-info-env (:include info-env)) - ;; If this value is EQ to the name we want to look up, then the cache hit - ;; function can be called instead of the lookup function. +;;; This is a closed hashtable, with the bucket being computed by +;;; taking the GLOBALDB-SXHASHOID of the NAME modulo the table size. +(defstruct (volatile-info-env (:include info-env) + (:copier nil)) + ;; If this value is EQ to the name we want to look up, then the + ;; cache hit function can be called instead of the lookup function. (cache-name 0) - ;; The alist translating type numbers to values for the currently cached - ;; name. + ;; the alist translating type numbers to values for the currently + ;; cached name (cache-types nil :type list) - ;; Vector of alists of alists of the form: + ;; vector of alists of alists of the form: ;; ((Name . ((Type-Number . Value) ...) ...) - (table (required-argument) :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. + (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) - ;; The number of names at which we should grow the table and rehash. + ;; the number of names at which we should grow the table and rehash (threshold 0 :type index)) ;;; Just like COMPACT-INFO-CACHE-HIT, only do it on a volatile environment. @@ -652,7 +713,8 @@ ;;; 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) + (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))) ()) @@ -663,11 +725,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 @@ -749,30 +810,33 @@ ;;; foldable.) ;;; INFO is the standard way to access the database. It's settable. +;;; +;;; Return the information of the specified TYPE and CLASS for NAME. +;;; The second value returned is true if there is any such information +;;; recorded. If there is no information, the first value returned is +;;; the default and the second value returned is NIL. (defun info (class type name &optional (env-list nil env-list-p)) - #!+sb-doc - "Return the information of the specified TYPE and CLASS for NAME. - The second value returned is true if there is any such information - recorded. If there is no information, the first value returned is - the default and the second value returned is NIL." - ;; FIXME: At some point check systematically to make sure that the system - ;; doesn't do any full calls to INFO or (SETF INFO), or at least none in any - ;; inner loops. + ;; FIXME: At some point check systematically to make sure that the + ;; system doesn't do any full calls to INFO or (SETF INFO), or at + ;; least none in any inner loops. (let ((info (type-info-or-lose class type))) (if env-list-p - (get-info-value name (type-info-number info) env-list) - (get-info-value name (type-info-number info))))) + (get-info-value name (type-info-number info) env-list) + (get-info-value name (type-info-number info))))) #!-sb-fluid (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. + ;; 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))) - `(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 @@ -782,13 +846,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. @@ -822,10 +886,12 @@ whole))) |# -;;; the maximum density of the hashtable in a volatile env (in names/bucket) -;;; FIXME: actually seems to be measured in percent, should be converted -;;; to be measured in names/bucket -(defconstant volatile-info-environment-density 50) +;;; the maximum density of the hashtable in a volatile env (in +;;; names/bucket) +;;; +;;; FIXME: actually seems to be measured in percent, should be +;;; converted to be measured in names/bucket +(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")) @@ -836,11 +902,10 @@ :table (make-array table-size :initial-element nil) :threshold size))) +;;; Clear the information of the specified TYPE and CLASS for NAME in +;;; the current environment, allowing any inherited info to become +;;; visible. We return true if there was any info. (defun clear-info (class type name) - #!+sb-doc - "Clear the information of the specified Type and Class for Name in the - current environment, allowing any inherited info to become visible. We - return true if there was any info." (let ((info (type-info-or-lose class type))) (clear-info-value name (type-info-number info)))) #!-sb-fluid @@ -881,14 +946,21 @@ ;;; Check whether the name and type is in our cache, if so return it. ;;; Otherwise, search for the value and encache it. ;;; -;;; Return the value from the first environment which has it defined, or -;;; return the default if none does. We have a cache for the last name looked -;;; up in each environment. We don't compute the hash until the first time the -;;; cache misses. When the cache does miss, we invalidate it before calling the -;;; lookup routine to eliminate the possiblity of the cache being partially -;;; updated if the lookup is interrupted. +;;; Return the value from the first environment which has it defined, +;;; or return the default if none does. We have a cache for the last +;;; name looked up in each environment. We don't compute the hash +;;; until the first time the cache misses. When the cache does miss, +;;; we invalidate it before calling the lookup routine to eliminate +;;; the possibility of the cache being partially updated if the lookup +;;; is interrupted. (defun get-info-value (name0 type &optional (env-list nil env-list-p)) (declare (type type-number type)) + ;; sanity check: If we have screwed up initialization somehow, then + ;; *INFO-TYPES* could still be uninitialized at the time we try to + ;; get an info value, and then we'd be out of luck. (This happened, + ;; and was confusing to debug, when rewriting EVAL-WHEN in + ;; sbcl-0.pre7.x.) + (aver (aref *info-types* type)) (let ((name (uncross name0))) (flet ((lookup-ignoring-global-cache (env-list) (let ((hash nil)) @@ -908,11 +980,15 @@ (multiple-value-bind (value winp) (,cache env type) (when winp (return (values value t))))))) - (if (typep env 'volatile-info-env) - (frob volatile-info-lookup volatile-info-cache-hit - volatile-info-env-cache-name) - (frob compact-info-lookup compact-info-cache-hit - compact-info-env-cache-name))))))) + (etypecase env + (volatile-info-env (frob + volatile-info-lookup + volatile-info-cache-hit + volatile-info-env-cache-name)) + (compact-info-env (frob + compact-info-lookup + compact-info-cache-hit + compact-info-env-cache-name)))))))) (cond (env-list-p (lookup-ignoring-global-cache env-list)) (t @@ -929,17 +1005,18 @@ (define-info-class :function) -;;; The kind of functional object being described. If null, Name isn't a known -;;; functional object. +;;; the kind of functional object being described. If null, NAME isn't +;;; a known functional object. (define-info-type :class :function :type :kind :type-spec (member nil :function :macro :special-form) - ;; I'm a little confused what the correct behavior of this default is. It's - ;; not clear how to generalize the FBOUNDP expression to the cross-compiler. - ;; As far as I can tell, NIL is a safe default -- it might keep the compiler - ;; from making some valid optimization, but it shouldn't produce incorrect - ;; code. -- WHN 19990330 + ;; I'm a little confused what the correct behavior of this default + ;; is. It's not clear how to generalize the FBOUNDP expression to + ;; the cross-compiler. As far as I can tell, NIL is a safe default + ;; -- it might keep the compiler from making some valid + ;; optimization, but it shouldn't produce incorrect code. -- WHN + ;; 19990330 :default #+sb-xc-host nil #-sb-xc-host (if (fboundp name) :function nil)) @@ -949,31 +1026,34 @@ :class :function :type :type :type-spec ctype - ;; Again (as in DEFINE-INFO-TYPE :CLASS :FUNCTION :TYPE :KIND) it's not clear - ;; how to generalize the FBOUNDP expression to the cross-compiler. - ;; -- WHN 19990330 + ;; Again (as in DEFINE-INFO-TYPE :CLASS :FUNCTION :TYPE :KIND) it's + ;; not clear how to generalize the FBOUNDP expression to the + ;; cross-compiler. -- WHN 19990330 :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 due to not -;;; having a declaration or definition. +;;; the ASSUMED-TYPE for this function, if we have to infer the type +;;; due to not having a declaration or definition (define-info-type :class :function :type :assumed-type - :type-spec (or approximate-function-type null)) - -;;; Where this information came from: -;;; :DECLARED = from a declaration. -;;; :ASSUMED = from uses of the object. -;;; :DEFINED = from examination of the definition. -;;; FIXME: The :DEFINED assumption that the definition won't change isn't ANSI. -;;; KLUDGE: CMU CL uses function type information in a way which violates -;;; its "type declarations are assertions" principle, and SBCL has inherited -;;; that behavior. It would be really good to fix the compiler so that it -;;; tests the return types of functions.. -- WHN ca. 19990801 + ;; FIXME: The type-spec really should be + ;; (or approximate-fun-type null)). + ;; It was changed to T as a hopefully-temporary hack while getting + ;; cold init problems untangled. + :type-spec t) + +;;; where this information came from: +;;; :ASSUMED = from uses of the object +;;; :DEFINED = from examination of the definition +;;; :DECLARED = from a declaration +;;; :DEFINED trumps :ASSUMED, and :DECLARED trumps :DEFINED. +;;; :DEFINED and :ASSUMED are useful for issuing compile-time warnings, +;;; and :DECLARED is useful for ANSIly specializing code which +;;; implements the function, or which uses the function's return values. (define-info-type :class :function :type :where-from @@ -985,69 +1065,74 @@ #+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) -;;; Specifies whether this function may be expanded inline. If null, we -;;; don't care. +;;; This specifies whether this function may be expanded inline. If +;;; null, we don't care. (define-info-type :class :function :type :inlinep :type-spec inlinep :default nil) -;;; A macro-like function which transforms a call to this function +;;; a macro-like function which transforms a call to this function ;;; into some other Lisp form. This expansion is inhibited if inline -;;; expansion is inhibited. +;;; expansion is inhibited (define-info-type :class :function :type :source-transform :type-spec (or function null)) -;;; The macroexpansion function for this macro. +;;; the macroexpansion function for this macro (define-info-type :class :function :type :macro-function :type-spec (or function null) :default nil) -;;; The compiler-macroexpansion function for this macro. +;;; the compiler-macroexpansion function for this macro (define-info-type :class :function :type :compiler-macro-function :type-spec (or function null) :default nil) -;;; A function which converts this special form into IR1. +;;; a function which converts this special form into IR1 (define-info-type :class :function :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 FUNCTION-INFO +;;; 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 @@ -1059,45 +1144,58 @@ (define-info-type :class :function :type :definition - :type-spec t + :type-spec (or fdefn null) :default nil) ;;;; definitions for other miscellaneous information (define-info-class :variable) -;;; The kind of variable-like thing described. +;;; the kind of variable-like thing described (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. +;;; the declared type for this variable (define-info-type :class :variable :type :type :type-spec ctype :default *universal-type*) -;;; Where this type and kind information came from. +;;; where this type and kind information came from (define-info-type :class :variable :type :where-from :type-spec (member :declared :assumed :defined) :default :assumed) -;;; The lisp object which is the value of this constant, if known. +;;; the Lisp object which is the value of this constant, if known (define-info-type :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 @@ -1113,15 +1211,18 @@ (define-info-class :type) -;;; The kind of type described. We return :INSTANCE for standard types that -;;; are implemented as structures. +;;; the kind of type described. We return :INSTANCE for standard types +;;; 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) -;;; Expander function for a defined type. +;;; the expander function for a defined type (define-info-type :class :type :type :expander @@ -1133,42 +1234,43 @@ :type :documentation :type-spec (or string null)) -;;; Function that parses type specifiers into CTYPE structures. +;;; function that parses type specifiers into CTYPE structures (define-info-type :class :type :type :translator :type-spec (or function null) :default nil) -;;; If true, then the type coresponding to this name. Note that if this is a -;;; built-in class with a translation, then this is the translation, not the -;;; class object. This info type keeps track of various atomic types (NIL etc.) -;;; and also serves as a cache to ensure that common standard types (atomic and -;;; otherwise) are only consed once. +;;; If true, then the type coresponding to this name. Note that if +;;; this is a built-in class with a translation, then this is the +;;; translation, not the class object. This info type keeps track of +;;; various atomic types (NIL etc.) and also serves as a cache to +;;; ensure that common standard types (atomic and otherwise) are only +;;; consed once. (define-info-type :class :type :type :builtin :type-spec (or ctype null) :default nil) -;;; 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 meaningful error if we only -;;; have the cons. +;;; 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 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. +;;; layout for this type being used by the compiler (define-info-type :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 @@ -1176,6 +1278,11 @@ :type :info :type-spec t :default nil) +(define-info-type + :class :typed-structure + :type :documentation + :type-spec (or string null) + :default nil) (define-info-class :declaration) (define-info-type @@ -1235,8 +1342,8 @@ :type-spec (or function null) :default nil) -;;; Used for storing miscellaneous documentation types. The stuff is an alist -;;; translating documentation kinds to values. +;;; This is used for storing miscellaneous documentation types. The +;;; stuff is an alist translating documentation kinds to values. (define-info-class :random-documentation) (define-info-type :class :random-documentation @@ -1246,18 +1353,13 @@ #!-sb-fluid (declaim (freeze-type info-env)) -;;; Now that we have finished initializing *INFO-CLASSES* and *INFO-TYPES* (at -;;; compile time), generate code to set them at cold load time to the same -;;; state they have currently. +;;; Now that we have finished initializing *INFO-CLASSES* and +;;; *INFO-TYPES* (at compile time), generate code to set them at cold +;;; load time to the same state they have currently. (!cold-init-forms (/show0 "beginning *INFO-CLASSES* init, calling MAKE-HASH-TABLE") (setf *info-classes* - (make-hash-table :size #.(hash-table-size *info-classes*) - ;; FIXME: These remaining arguments are only here - ;; for debugging, to try track down weird cold - ;; boot problems. - #|:rehash-size 1.5 - :rehash-threshold 1|#)) + (make-hash-table :size #.(hash-table-size *info-classes*))) (/show0 "done with MAKE-HASH-TABLE in *INFO-CLASSES* init") (dolist (class-info-name '#.(let ((result nil)) (maphash (lambda (key value) @@ -1273,12 +1375,15 @@ (setf *info-types* (map 'vector (lambda (x) + (/show0 "in LAMBDA (X), X=..") + (/hexstr x) (when x (let* ((class-info (class-info-or-lose (second x))) (type-info (make-type-info :name (first x) :class class-info :number (third x) :type (fourth x)))) + (/show0 "got CLASS-INFO in LAMBDA (X)") (push type-info (class-info-types class-info)) type-info))) '#.(map 'list @@ -1291,11 +1396,11 @@ *info-types*))) (/show0 "done with *INFO-TYPES* initialization")) -;;; At cold load time, after the INFO-TYPE objects have been created, we can -;;; set their DEFAULT and TYPE slots. +;;; At cold load time, after the INFO-TYPE objects have been created, +;;; we can set their DEFAULT and TYPE slots. (macrolet ((frob () `(!cold-init-forms - ,@(reverse *reversed-type-info-init-forms*)))) + ,@(reverse *!reversed-type-info-init-forms*)))) (frob)) ;;;; a hack for detecting @@ -1305,11 +1410,11 @@ ;;;; ..) ;;;; (DEFSETF BAR SET-BAR) ; can't influence previous compilation ;;;; -;;;; KLUDGE: Arguably it should be another class/type combination in the -;;;; globaldb. However, IMHO the whole globaldb/fdefinition treatment of setf -;;;; functions is a mess which ought to be rewritten, and I'm not inclined to -;;;; mess with it short of that. So I just put this bag on the side of it -;;;; instead.. +;;;; KLUDGE: Arguably it should be another class/type combination in +;;;; the globaldb. However, IMHO the whole globaldb/fdefinition +;;;; treatment of SETF functions is a mess which ought to be +;;;; rewritten, and I'm not inclined to mess with it short of that. So +;;;; I just put this bag on the side of it instead.. ;;; true for symbols FOO which have been assumed to have '(SETF FOO) ;;; bound to a function