X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftarget-sxhash.lisp;h=df0ec1200e7e251374332dd0227ef1cf2910145b;hb=fedd9f4e92ddb1b599695043eb1dafe356475afc;hp=55d23c5a4b4389a908a25c0983ccc5a61e90f275;hpb=43bcf8d9123731a616de9332d247fa6070506054;p=sbcl.git

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 55d23c5..df0ec12 100644
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -89,28 +89,20 @@
   (declare (optimize (speed 3) (safety 0)))
   (declare (type string string))
   (declare (type index count))
-  (let ((result 0))
-    (declare (type (unsigned-byte 32) result))
-    (unless (typep string '(vector nil))
-      (dotimes (i count)
-	(declare (type index i))
-	(setf result
-	      (ldb (byte 32 0)
-		   (+ result (char-code (aref string i)))))
-	(setf result
-	      (ldb (byte 32 0)
-		   (+ result (ash result 10))))
-	(setf result
-	      (logxor result (ash result -6)))))
-    (setf result
-	  (ldb (byte 32 0)
-	       (+ result (ash result 3))))
-    (setf result
-	  (logxor result (ash result -11)))
-    (setf result
-	  (ldb (byte 32 0)
-	       (logxor result (ash result 15))))
-    (logand result most-positive-fixnum)))
+  (macrolet ((set-result (form)
+	       `(setf result (ldb (byte #.sb!vm:n-word-bits 0) ,form))))
+    (let ((result 0))
+      (declare (type (unsigned-byte #.sb!vm:n-word-bits) result))
+      (unless (typep string '(vector nil))
+	(dotimes (i count)
+	  (declare (type index i))
+	  (set-result (+ result (char-code (aref string i))))
+	  (set-result (+ result (ash result 10)))
+	  (set-result (logxor result (ash result -6)))))
+      (set-result (+ result (ash result 3)))
+      (set-result (logxor result (ash result -11)))
+      (set-result (logxor result (ash result 15)))
+      (logand result most-positive-fixnum))))
 ;;; test:
 ;;;   (let ((ht (make-hash-table :test 'equal)))
 ;;;     (do-all-symbols (symbol)
@@ -175,11 +167,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