X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=c73acaa426787c456d4c4549814a2cd57f02e5ac;hb=b63c4fb9b98fa8188e17ba926e150ba417a74635;hp=8a7a6ef6495ffbb51b93f18ce652c6e038f0428d;hpb=22b819c0cd0ca0ea5be52ba280b9e9e0b8e86210;p=sbcl.git

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 8a7a6ef..c73acaa 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -32,11 +32,7 @@
 (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
@@ -58,17 +54,17 @@
 ;;; 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.
@@ -263,7 +259,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 +316,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
@@ -541,7 +537,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 +712,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,7 +725,6 @@
 		(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
@@ -896,7 +906,6 @@
 ;;; 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
@@ -1386,7 +1395,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