;;; 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)
+(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
(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
,(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
;;; 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))
;;; 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))) ())
(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
;; Constant CLASS and TYPE is an overwhelmingly common special case,
;; and we can implement it much more efficiently than the general case.
(if (and (constantp class) (constantp type))
- (let ((info (type-info-or-lose class type))
- (value (gensym "VALUE"))
- (foundp (gensym "FOUNDP")))
- `(multiple-value-bind (,value ,foundp)
- (get-info-value ,name
- ,(type-info-number info)
- ,@(when env-list-p `(,env-list)))
- (declare (type ,(type-info-type info) ,value))
- (values ,value ,foundp)))
+ (let ((info (type-info-or-lose class type)))
+ (with-unique-names (value foundp)
+ `(multiple-value-bind (,value ,foundp)
+ (get-info-value ,name
+ ,(type-info-number info)
+ ,@(when env-list-p `(,env-list)))
+ (declare (type ,(type-info-type info) ,value))
+ (values ,value ,foundp))))
whole))
(defun (setf info) (new-value
class
;; (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
:type :ir1-convert
:type-spec (or function null))
-;;; a function which gets a chance to do stuff to the IR1 for any call
-;;; to this function.
-(define-info-type
- :class :function
- :type :ir1-transform
- :type-spec (or function null))
-
;;; If a function is "known" to the compiler, then this is a FUN-INFO
;;; structure containing the info used to special-case compilation.
(define-info-type
(define-info-type
:class :function
:type :definition
- :type-spec t
+ :type-spec (or fdefn null)
:default nil)
\f
;;;; definitions for other miscellaneous information
;;; 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
: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
;;; 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))
\f
;;;; a hack for detecting
projects / sbcl.git / blobdiff