1.0.21.25: LOAD-SHARED-OBJECT and logical pathnames

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

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 5ddbd21..fe8fc8a 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -11,6 +11,15 @@
 
 (in-package "SB!IMPL")
 
 
 (in-package "SB!IMPL")
 

+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant max-hash sb!xc:most-positive-fixnum))
+
+(deftype hash ()
+  `(integer 0 ,max-hash))
+
+(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
 ;;; the depthoid explored when calculating hash values
 ;;;
 ;;; "Depthoid" here is a sort of mixture of what Common Lisp ordinarily calls

@@ -80,7 +89,7 @@
 ;;;; <http://burtleburtle.net/bob/hash/doobs.html> for some more
 ;;;; information).
 
 ;;;; <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
 (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

@@ -250,12 +259,13 @@
                   '(let ((result 572539))
                      (declare (type fixnum result))
                      (mixf result (length key))
                   '(let ((result 572539))
                      (declare (type fixnum result))
                      (mixf result (length key))

-                     (dotimes (i (length key))
+                    (when (plusp depthoid)
+                      (decf depthoid)
+                      (dotimes (i (length key))

                        (declare (type fixnum i))
                        (mixf result
                        (declare (type fixnum i))
                        (mixf result

-                             (psxhash (aref key i)
-                                      (- depthoid 1 i))))
-                     result))
+                             (psxhash (aref key i) depthoid))))
+                    result))

                 (make-dispatch (types)
                   `(typecase key
                      ,@(loop for type in types
                 (make-dispatch (types)
                   `(typecase key
                      ,@(loop for type in types

@@ -274,10 +284,11 @@
        (declare (type fixnum result))
        (dotimes (i (array-rank key))
          (mixf result (array-dimension key i)))
        (declare (type fixnum result))
        (dotimes (i (array-rank key))
          (mixf result (array-dimension key i)))

-       (dotimes (i (array-total-size key))
-         (mixf result
-               (psxhash (row-major-aref key i)
-                        (- depthoid 1 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)
        result))))
 
 (defun structure-object-psxhash (key depthoid)