X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=f7fbd60e78556b97794d5a78ef492b4eaf7d877a;hb=6a9bbe6f36179cee92001a1f9ed5ff38be512644;hp=0538c43d01de711181045bf269487efb42dbee35;hpb=ad1aa2961d81ed8db9dac59068c6861199c29a3a;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 0538c43..f7fbd60 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -263,7 +263,7 @@ ;;; 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 @@ -320,7 +320,7 @@ (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 @@ -360,7 +360,7 @@ ,(do-compact-info name class type type-number value n-env body))))) -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) ;;; Return code to iterate over a compact info environment. (defun do-compact-info (name-var class-var type-var type-number-var value-var @@ -541,7 +541,20 @@ ;;; 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)) @@ -703,7 +716,9 @@ ;;; Just like COMPACT-INFO-LOOKUP, only do it on a volatile environment. (defun volatile-info-lookup (env name hash) - (declare (type volatile-info-env env) (type index hash)) + (declare (type volatile-info-env env) + ;; FIXME: see comment in COMPACT-INFO-LOOKUP + (type (integer 0 #.sb!xc:most-positive-fixnum) hash)) (let ((table (volatile-info-env-table env))) (macrolet ((lookup (test) `(dolist (entry (svref table (mod hash (length table))) ()) @@ -714,11 +729,10 @@ (lookup eq) (lookup equal))) (setf (volatile-info-env-cache-name env) name))) - (values)) -;;; Given a volatile environment Env, bind Table-Var the environment's table -;;; and Index-Var to the index of Name's bucket in the table. We also flush +;;; Given a volatile environment ENV, bind TABLE-VAR the environment's table +;;; and INDEX-VAR to the index of NAME's bucket in the table. We also flush ;;; the cache so that things will be consistent if body modifies something. (eval-when (:compile-toplevel :execute) (#+sb-xc-host cl:defmacro @@ -819,15 +833,14 @@ ;; 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 @@ -1036,7 +1049,7 @@ ;; (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 @@ -1119,13 +1132,6 @@ :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 @@ -1143,7 +1149,7 @@ (define-info-type :class :function :type :definition - :type-spec t + :type-spec (or fdefn null) :default nil) ;;;; definitions for other miscellaneous information @@ -1259,8 +1265,8 @@ ;;; 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 @@ -1268,8 +1274,8 @@ :class :type :type :compiler-layout :type-spec (or layout null) - :default (let ((class (sb!xc:find-class name nil))) - (when class (class-layout class)))) + :default (let ((class (find-classoid name nil))) + (when class (classoid-layout class)))) (define-info-class :typed-structure) (define-info-type @@ -1394,7 +1400,7 @@ ;;; 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