X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=c73acaa426787c456d4c4549814a2cd57f02e5ac;hb=ca267caa3bdb897a93a1e69ae7300ba3ba5d391f;hp=f7fbd60e78556b97794d5a78ef492b4eaf7d877a;hpb=ba94fb1763a2f1e01a3b75a9e1415f051c5a559f;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index f7fbd60..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. @@ -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) - #!+sb-doc (let ((info (type-info-or-lose class type))) (clear-info-value name (type-info-number info)))) #!-sb-fluid