[Sbcl-commits] CVS: sbcl/src/code sxhash.lisp,1.8,1.9 target-sxhash.lisp,1.18,1.19

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28760/src/code

Modified Files:
	sxhash.lisp target-sxhash.lisp 
Log Message:
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


Index: sxhash.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/sxhash.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- sxhash.lisp	22 May 2004 14:50:04 -0000	1.8
+++ sxhash.lisp	15 Jul 2004 09:38:13 -0000	1.9
@@ -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)))))

Index: target-sxhash.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-sxhash.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- target-sxhash.lisp	22 May 2004 14:50:04 -0000	1.18
+++ target-sxhash.lisp	15 Jul 2004 09:38:13 -0000	1.19
@@ -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