0.8.19.32:

[sbcl.git] / src / compiler / globaldb.lisp

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index f7fbd60..c73acaa 100644 (file)
--- 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
 (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
 ;;;
 ;;; 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)
 ;;; 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)))))
        ((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.
        (t (sxhash x))))
 
 ;;; Given any non-negative integer, return a prime number >= to it.

@@ -910,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)
 ;;; 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
   (let ((info (type-info-or-lose class type)))
     (clear-info-value name (type-info-number info))))
 #!-sb-fluid