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

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 571b9c1..99e0830 100644
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -70,25 +70,46 @@
 
 ;;;; 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))
+  (let ((result 0))
+    (declare (type (unsigned-byte 32) 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))
+	(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)))
 ;;; test:
 ;;;   (let ((ht (make-hash-table :test 'equal)))
 ;;;     (do-all-symbols (symbol)
@@ -103,13 +124,23 @@
 (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