(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.
+;;; legal function names.
;;;
;;; Why optimize? We want to avoid the fully-general TYPECASE in ordinary
;;; SXHASH, because
;;; 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.)
+ (cond ((symbolp x) (sxhash x))
((and (listp x)
(eq (first x) 'setf)
(let ((rest (rest x)))
(and (symbolp (car rest))
(null (cdr rest)))))
- (logxor (symbol-hash (second x))
- 110680597))
+ ;; 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.
;;; 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
;;; 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
;;; 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
(let ((info (type-info-or-lose class type)))
(clear-info-value name (type-info-number info))))
#!-sb-fluid
;;; 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