,(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
;; 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