1.0.27.31: repeatable fasl header and debug-source

[sbcl.git] / src / code / target-sxhash.lisp

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index dbe9d23..28bbf84 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -11,6 +11,9 @@
 
 (in-package "SB!IMPL")
 
+(defun pointer-hash (key)
+  (pointer-hash key))
+
 ;;; the depthoid explored when calculating hash values
 ;;;
 ;;; "Depthoid" here is a sort of mixture of what Common Lisp ordinarily calls
@@ -40,6 +43,7 @@
                             (and fixnum unsigned-byte))
                            (and fixnum unsigned-byte))
                 mix))
+(declaim (inline 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,
@@ -79,7 +83,7 @@
 ;;;; <http://burtleburtle.net/bob/hash/doobs.html> for some more
 ;;;; information).
 
-#!-sb-fluid (declaim (inline %sxhash-substring))
+(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
@@ -138,24 +142,8 @@
 ;;;; 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))
-
-(defmacro hash-array-using (recurse array depthoid)
-  ;; Any other array can be hashed by working with its underlying
-  ;; one-dimensional physical representation. Used by both SXHASH and
-  ;; PSXHASH.
-  (once-only ((array array) (depthoid depthoid))
-    `(let ((result 60828123))
-       (declare (type fixnum result))
-       (dotimes (i (min ,depthoid (array-rank ,array)))
-         (mixf result (array-dimension ,array i)))
-       (dotimes (i (min ,depthoid (array-total-size ,array)))
-         (mixf result
-               (,recurse (row-major-aref ,array i) (- ,depthoid 1 i))))
-       result)))
+(declaim (ftype (sfunction (integer) hash) sxhash-bignum))
+(declaim (ftype (sfunction (t) hash) sxhash-instance))
 
 (defun sxhash (x)
   ;; profiling SXHASH is hard, but we might as well try to make it go
@@ -215,8 +203,7 @@
                    ;; work needs to be done using the %RAW-BITS
                    ;; approach.  This will probably do for now.
                    (sxhash-recurse (copy-seq x) depthoid))
-                  (t
-                   (hash-array-using sxhash-recurse x depthoid))))
+                  (t (logxor 191020317 (sxhash (array-rank x))))))
                (character
                 (logxor 72185131
                         (sxhash (char-code x)))) ; through DEFTRANSFORM
@@ -249,7 +236,7 @@
     (structure-object (structure-object-psxhash key depthoid))
     (cons (list-psxhash key depthoid))
     (number (number-psxhash key))
-    (character (sxhash (char-upcase key)))
+    (character (char-code (char-upcase key)))
     (t (sxhash key))))
 
 (defun array-psxhash (key depthoid)
@@ -264,25 +251,37 @@
                   '(let ((result 572539))
                      (declare (type fixnum result))
                      (mixf result (length key))
-                     (dotimes (i (min depthoid (length key)))
+                    (when (plusp depthoid)
+                      (decf depthoid)
+                      (dotimes (i (length key))
                        (declare (type fixnum i))
                        (mixf result
-                             (psxhash (aref key i)
-                                      (- depthoid 1 i))))
-                     result)))
-       ;; CMU can compile SIMPLE-ARRAY operations so much more efficiently
-       ;; than the general case that it's probably worth picking off the
-       ;; common special cases.
-       (typecase key
-         (simple-string
-          ;;(format t "~&SIMPLE-STRING special case~%")
-          (frob))
-         (simple-vector
-          ;;(format t "~&SIMPLE-VECTOR special case~%")
-          (frob))
-         (t (frob)))))
+                             (psxhash (aref key i) depthoid))))
+                    result))
+                (make-dispatch (types)
+                  `(typecase key
+                     ,@(loop for type in types
+                             collect `(,type
+                                       (frob))))))
+       (make-dispatch (simple-base-string
+                       (simple-array character (*))
+                       simple-vector
+                       (simple-array (unsigned-byte 8) (*))
+                       (simple-array fixnum (*))
+                       t))))
+    ;; Any other array can be hashed by working with its underlying
+    ;; one-dimensional physical representation.
     (t
-     (hash-array-using psxhash key depthoid))))
+     (let ((result 60828))
+       (declare (type fixnum result))
+       (dotimes (i (array-rank key))
+         (mixf result (array-dimension key i)))
+       (when (plusp depthoid)
+         (decf depthoid)
+         (dotimes (i (array-total-size key))
+          (mixf result
+                (psxhash (row-major-aref key i) depthoid))))
+       result))))
 
 (defun structure-object-psxhash (key depthoid)
   (declare (optimize speed))