0.8.12.35:

	Possibly pointless micro-optimization for SXHASH
	... type tests for CONS are more expensive than type tests for
		LIST.  Distinguish between CONS and LIST manually, then,
		so that we can return the right answer more quickly for
		NIL.
	... exposes a bug in the cross-compiler: SXHASH is most
		definitely not constant-foldable there.
	... be even more paranoid about SXHASH/PSXHASH testing

diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS
index 0ca48de..1f8746f 100644 (file)
--- a/OPTIMIZATIONS
+++ b/OPTIMIZATIONS
@@ -185,3 +185,8 @@ sbcl-0.8.12.30, this affects at least DUMP-OBJECT through
 COMPOUND-OBJECT-P, and (LABELS MAYBE-EMIT-MAKE-LOAD-FORMS GROVEL)
 through TYPEP UNBOXED-ARRAY, within the compiler itself.
 --------------------------------------------------------------------------------
+#18
+(lambda (x) (declare (null x)) (sxhash x)) goes through SYMBOL-HASH
+rather than either constant-folding or manipulating NIL-VALUE or
+NULL-TN directly.
+--------------------------------------------------------------------------------

diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp
index c2b7027..2afbee6 100644 (file)
--- a/src/code/sxhash.lisp
+++ b/src/code/sxhash.lisp
@@ -103,18 +103,29 @@
 (deftransform sxhash ((x) (symbol))
   (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
       (sxhash (lvar-value x))
-      ;; Cache the value of the symbol's sxhash in the symbol-hash slot.
-      '(let ((result (symbol-hash x)))
-       ;; 0 marks uninitialized slot. We can't use negative values
-       ;; for the uninitialized slots since NIL might be located so
-       ;; high in memory on some platforms that its SYMBOL-HASH
-       ;; (which contains NIL itself) is a negative fixnum.
-       (if (= 0 result)
-           (let ((sxhash (%sxhash-simple-string (symbol-name x))))
-             ;; We could do a (logior sxhash #x10000000) to ensure
-             ;; that we never store a 0 in the slot. However, it's
-             ;; such an unlikely event (1/5e8?) that it makes more
-             ;; sense to optimize for the common case...
-             (%set-symbol-hash x sxhash)
-             sxhash)
-           result))))
+      (if (csubtypep (lvar-type x) (specifier-type 'null))
+         ;; FIXME: this isn't in fact as optimized as it could be;
+         ;; this does a memory load, whereas (because we know the
+         ;; layout of NIL) we could simply take the address of NIL
+         ;; (or the contents of NULL-TN) and mask off the appropriate
+         ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which
+         ;; is NIL.  -- CSR, 2004-07-14
+         '(symbol-hash x)
+         ;; Cache the value of the symbol's sxhash in the symbol-hash
+         ;; slot.
+         '(let ((result (symbol-hash x)))
+           ;; 0 marks uninitialized slot. We can't use negative
+           ;; values for the uninitialized slots since NIL might be
+           ;; located so high in memory on some platforms that its
+           ;; SYMBOL-HASH (which contains NIL itself) is a negative
+           ;; fixnum.
+           (if (= 0 result)
+               (let ((sxhash (%sxhash-simple-string (symbol-name x))))
+                 ;; We could do a (logior sxhash #x10000000) to
+                 ;; ensure that we never store a 0 in the
+                 ;; slot. However, it's such an unlikely event
+                 ;; (1/5e8?) that it makes more sense to optimize for
+                 ;; the common case...
+                 (%set-symbol-hash x sxhash)
+                 sxhash)
+               result)))))

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 55d23c5..38422a1 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -175,11 +175,19 @@
           (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+))
             (declare (type index depthoid))
             (typecase x
-              (cons
-               (if (plusp depthoid)
-                   (mix (sxhash-recurse (car x) (1- depthoid))
-                        (sxhash-recurse (cdr x) (1- depthoid)))
-                   261835505))
+              ;; we test for LIST here, rather than CONS, because the
+              ;; type test for CONS is in fact the test for
+              ;; LIST-POINTER-LOWTAG followed by a negated test for
+              ;; NIL.  If we're going to have to test for NIL anyway,
+              ;; we might as well do it explicitly and pick off the
+              ;; answer.  -- CSR, 2004-07-14
+              (list
+               (if (null x)
+                   (sxhash x) ; through DEFTRANSFORM
+                   (if (plusp depthoid)
+                       (mix (sxhash-recurse (car x) (1- depthoid))
+                            (sxhash-recurse (cdr x) (1- depthoid)))
+                       261835505)))
               (instance
                (if (or (typep x 'structure-object) (typep x 'condition))
                    (logxor 422371266

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index af64d73..49c58a3 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -787,7 +787,7 @@
 (defknown hash-table-size (hash-table) index (flushable))
 (defknown hash-table-test (hash-table) symbol (foldable flushable))
 (defknown sxhash (t) (integer 0 #.sb!xc:most-positive-fixnum)
-  (foldable flushable))
+  (#-sb-xc-host foldable flushable))
 \f
 ;;;; from the "Arrays" chapter
 

diff --git a/tests/hash.impure.lisp b/tests/hash.impure.lisp
index ee9e538..dfbb9c4 100644 (file)
--- a/tests/hash.impure.lisp
+++ b/tests/hash.impure.lisp
@@ -241,7 +241,8 @@
 
 ;;; NIL is both SYMBOL and LIST
 (dolist (fun '(sxhash sb-impl::psxhash))
-  (assert (= (funcall fun nil)
+  (assert (= (eval `(,fun nil))
+            (funcall fun nil)
              (funcall (compile nil `(lambda (x)
                                       (declare (symbol x))
                                       (,fun x)))
@@ -249,6 +250,10 @@
              (funcall (compile nil `(lambda (x)
                                       (declare (list x))
                                       (,fun x)))
+                      nil)
+             (funcall (compile nil `(lambda (x)
+                                     (declare (null x))
+                                      (,fun x)))
                       nil))))
 
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 8cbdfed..3396edb 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.12.34"
+"0.8.12.35"