(in-package "SB!C")
-(file-comment
- "$Header$")
-
(!begin-collecting-cold-init-forms)
#!+sb-show (!cold-init-forms (/show0 "early in globaldb.lisp cold init"))
;;; 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. 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.
;;;
;;; Why optimize? We want to avoid the fully-general TYPECASE in ordinary
;;; SXHASH, because
;;; 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.)
;;; 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)))
\f
-;;;; 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.
+(defconstant 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
#-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.
(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 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.
(defvar *info-types*)
(declaim (type simple-vector *info-types*))
(eval-when (:compile-toplevel :execute)
"~S ~S, Number = ~D"
(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)
;; this type's class
(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))
(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
\f
-;;;; 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,
(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
;;; 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.
+;;; 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))
(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
: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))
\f
;;;; 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.
+;;; 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 (required-argument) :type string))
(def!method print-object ((x info-env) stream)
(print-unreadable-object (x stream :type t)
(declare (ignorable ,type-var ,class-var
,value-var))
,@body
- (unless (zerop (logand ,n-info compact-info-entry-last))
+ (unless (zerop (logand ,n-info
+ compact-info-entry-last))
(return-from ,PUNT))))))))))))))
;;; Return code to iterate over a volatile info environment.
(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)
;;; 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.
+ ;; 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.
+ ;; 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 (*)))
- ;; Vector contining in contiguous ranges the values of for all the types of
- ;; info for each name.
+ ;; 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
(values))
-;;; Exact density (modulo rounding) of the hashtable in a compact info
-;;; environment in names/bucket.
+;;; the exact density (modulo rounding) of the hashtable in a compact
+;;; info environment in names/bucket
(defconstant 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)))
(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)
: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))
(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
\f
;;;; 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.
+ ;; 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.
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
+;;; 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)
;;; Make a new volatile environment of the specified size.
(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))
: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))
(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))
+ ;; FIXME: The type-spec really should be
+ ;; (or approximate-function-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:
+;;; 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 :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
(define-info-type
:class :function
:type :where-from
#+sb-xc-host :assumed
#-sb-xc-host (if (fboundp name) :defined :assumed))
-;;; Lambda used for inline expansion of this function.
+;;; lambda used for inline expansion of this function
(define-info-type
:class :function
:type :inline-expansion
:type-spec list)
-;;; 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.
+;;; 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.
+;;; 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
-;;; structure containing the info used to special-case compilation.
+;;; If a function is "known" to the compiler, then this is a
+;;; FUNCTION-INFO structure containing the info used to special-case
+;;; compilation.
(define-info-type
:class :function
:type :info
: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 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)
: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 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
#!-sb-fluid (declaim (freeze-type info-env))
\f
-;;; 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)
(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
*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*))))
;;;; ..)
;;;; (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
projects / sbcl.git / blobdiff