X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sxhash.lisp;h=943ed0c62c8e18c0a24a3a919ac74231abc31e51;hb=9837343101c3da7b3a8f94609ec116ec5025436a;hp=5ddbd212d3fbc5d5fc907ff31cdc81a68e72f17a;hpb=9109df608080457c2fb2437c7eb5b9af23fe6cf2;p=sbcl.git diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index 5ddbd21..943ed0c 100644 --- 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 @@ -80,7 +83,7 @@ ;;;; 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 @@ -139,10 +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)) +(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 @@ -199,7 +200,7 @@ ;; than this. The problem is that a non-SIMPLE ;; BIT-VECTOR could be displaced to another, with a ;; non-zero offset -- so that significantly more - ;; work needs to be done using the %RAW-BITS + ;; work needs to be done using the %VECTOR-RAW-BITS ;; approach. This will probably do for now. (sxhash-recurse (copy-seq x) depthoid)) (t (logxor 191020317 (sxhash (array-rank x)))))) @@ -250,12 +251,13 @@ '(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 - (psxhash (aref key i) - (- depthoid 1 i)))) - result)) + (psxhash (aref key i) depthoid)))) + result)) (make-dispatch (types) `(typecase key ,@(loop for type in types @@ -274,10 +276,11 @@ (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) @@ -335,8 +338,8 @@ (etypecase key (integer (sxhash key)) (float (macrolet ((frob (type) - (let ((lo (coerce most-negative-fixnum type)) - (hi (coerce most-positive-fixnum type))) + (let ((lo (coerce sb!xc:most-negative-fixnum type)) + (hi (coerce sb!xc:most-positive-fixnum type))) `(cond (;; This clause allows FIXNUM-sized integer ;; values to be handled without consing. (<= ,lo key ,hi)