X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sxhash.lisp;h=35fdcdce89fb66509bfab67ad9a07c639952b861;hb=7cca1cabd213d38218a40e973b06ca11c8546396;hp=571b9c184cec137cf6b9f7d4561c23fb8cb360b7;hpb=b42068e9080417a073dcb709cdd2e0315599b3df;p=sbcl.git

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 571b9c1..35fdcdc 100644
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -36,9 +36,10 @@
 ;;;   * We'd like this to be simple and fast, too.
 ;;;
 ;;; FIXME: Should this be INLINE?
-(declaim (ftype (function ((and fixnum unsigned-byte)
-			   (and fixnum unsigned-byte))
-			  (and fixnum unsigned-byte)) mix))
+(declaim (ftype (sfunction ((and fixnum unsigned-byte)
+                            (and fixnum unsigned-byte))
+                           (and fixnum unsigned-byte))
+                mix))
 (defun mix (x y)
   ;; FIXME: We wouldn't need the nasty (SAFETY 0) here if the compiler
   ;; were smarter about optimizing ASH. (Without the THE FIXNUM below,
@@ -70,25 +71,38 @@
 
 ;;;; hashing strings
 ;;;;
-;;;; Note that this operation is used in compiler symbol table lookups, so we'd
-;;;; like it to be fast.
+;;;; Note that this operation is used in compiler symbol table
+;;;; lookups, so we'd like it to be fast.
+;;;;
+;;;; As of 2004-03-10, we implement the one-at-a-time algorithm
+;;;; designed by Bob Jenkins (see
+;;;; <http://burtleburtle.net/bob/hash/doobs.html> for some more
+;;;; information).
 
 #!-sb-fluid (declaim (inline %sxhash-substring))
 (defun %sxhash-substring (string &optional (count (length string)))
   ;; FIXME: As in MIX above, we wouldn't need (SAFETY 0) here if the
-  ;; cross-compiler were smarter about ASH, but we need it for sbcl-0.5.0m.
+  ;; cross-compiler were smarter about ASH, but we need it for
+  ;; sbcl-0.5.0m.  (probably no longer true?  We might need SAFETY 0
+  ;; to elide some type checks, but then again if this is inlined in
+  ;; all the critical places, we might not -- CSR, 2004-03-10)
   (declare (optimize (speed 3) (safety 0)))
   (declare (type string string))
   (declare (type index count))
-  (let ((result 408967240))
-    (declare (type fixnum result))
-    (unless (typep string '(vector nil))
-      (dotimes (i count)
-	(declare (type index i))
-	(mixf result
-	      (the fixnum
-		(ash (char-code (aref string i)) 5)))))
-    result))
+  (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)
@@ -103,16 +117,32 @@
 (defun %sxhash-simple-string (x)
   (declare (optimize speed))
   (declare (type simple-string x))
-  (%sxhash-substring x))
+  ;; KLUDGE: this FLET is a workaround (suggested by APD) for presence
+  ;; of let conversion in the cross compiler, which otherwise causes
+  ;; strongly suboptimal register allocation.
+  (flet ((trick (x)
+           (%sxhash-substring x)))
+    (declare (notinline trick))
+    (trick x)))
 
 (defun %sxhash-simple-substring (x count)
   (declare (optimize speed))
   (declare (type simple-string x))
   (declare (type index count))
-  (%sxhash-substring x count))
+  ;; see comment in %SXHASH-SIMPLE-STRING
+  (flet ((trick (x count)
+	   (%sxhash-substring x count)))
+    (declare (notinline trick))
+    (trick x count)))
 
 ;;;; the SXHASH function
 
+;; simple cases
+(declaim (ftype (sfunction (integer) (integer 0 #.sb!xc:most-positive-fixnum))
+                sxhash-bignum))
+(declaim (ftype (sfunction (t) (integer 0 #.sb!xc:most-positive-fixnum))
+                sxhash-instance))
+
 (defun sxhash (x)
   ;; profiling SXHASH is hard, but we might as well try to make it go
   ;; fast, in case it is the bottleneck somwhere.  -- CSR, 2003-03-14
@@ -134,14 +164,22 @@
 			  (mixf result (sxhash-number (realpart x)))
 			  (mixf result (sxhash-number (imagpart x)))
 			  result))))
-	   (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+))
+	   (sxhash-recurse (x 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
@@ -171,7 +209,7 @@
 	       (number (sxhash-number x))
 	       (generic-function (sxhash-instance x))
 	       (t 42))))
-    (sxhash-recurse x)))
+    (sxhash-recurse x +max-hash-depthoid+)))
 
 ;;;; the PSXHASH function