X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftarget-sxhash.lisp;h=9938b72a67ae7536f98f549743283978dd35b18f;hb=82cd148d729c241e79c8df04b700beec1b7c55de;hp=2db0559558ceb877d5a35e4ec3544d0ac5bff77c;hpb=a8674581f11d7c105500c7c24d4d6d167739745a;p=sbcl.git diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index 2db0559..9938b72 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 @@ -34,40 +37,39 @@ ;;; SXHASH function does, again helping to avoid pathologies like ;;; hashing all bit vectors to 1. ;;; * We'd like this to be simple and fast, too. -;;; -;;; FIXME: Should this be INLINE? (declaim (ftype (sfunction ((and fixnum unsigned-byte) (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, - ;; and the (SAFETY 0) declaration here to get the compiler to trust - ;; it, the sbcl-0.5.0m cross-compiler running under Debian - ;; cmucl-2.4.17 turns the ASH into a full call, requiring the - ;; UNSIGNED-BYTE 32 argument to be coerced to a bignum, requiring - ;; consing, and thus generally obliterating performance.) - (declare (optimize (speed 3) (safety 0))) + (declare (optimize (speed 3))) (declare (type (and fixnum unsigned-byte) x y)) ;; the ideas here: - ;; * Bits diffuse in both directions (shifted left by up to 2 places - ;; in the calculation of XY, and shifted right by up to 5 places - ;; by the ASH). + ;; * Bits diffuse in both directions (shifted arbitrarily left by + ;; the multiplication in the calculation of XY, and shifted + ;; right by up to 5 places by the ASH). ;; * The #'+ and #'LOGXOR operations don't commute with each other, ;; so different bit patterns are mixed together as they shift ;; past each other. - ;; * The arbitrary constant in the #'LOGXOR expression is intended - ;; to help break up any weird anomalies we might otherwise get - ;; when hashing highly regular patterns. + ;; * The arbitrary constant XOR used in the LOGXOR expression is + ;; intended to help break up any weird anomalies we might + ;; otherwise get when hashing highly regular patterns. ;; (These are vaguely like the ideas used in many cryptographic ;; algorithms, but we're not pushing them hard enough here for them ;; to be cryptographically strong.) - (let* ((xy (+ (* x 3) y))) - (logand most-positive-fixnum - (logxor 441516657 - xy - (ash xy -5))))) + ;; + ;; note: 3622009729038463111 is a 62-bit prime such that its low 61 + ;; bits, low 60 bits and low 29 bits are all also primes, thus + ;; giving decent distributions no matter which of the possible + ;; values of most-positive-fixnum we have. It is derived by simple + ;; search starting from 2^60*pi. The multiplication should be + ;; efficient no matter what the platform thanks to modular + ;; arithmetic. + (let* ((mul (logand 3622009729038463111 sb!xc:most-positive-fixnum)) + (xor (logand 608948948376289905 sb!xc:most-positive-fixnum)) + (xy (logand (+ (* x mul) y) sb!xc:most-positive-fixnum))) + (logand (logxor xor xy (ash xy -5)) sb!xc:most-positive-fixnum))) ;;;; hashing strings ;;;; @@ -79,7 +81,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 @@ -138,28 +140,12 @@ ;;;; 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 - ;; fast, in case it is the bottleneck somwhere. -- CSR, 2003-03-14 + ;; fast, in case it is the bottleneck somewhere. -- CSR, 2003-03-14 (declare (optimize speed)) (labels ((sxhash-number (x) (etypecase x @@ -195,12 +181,27 @@ (sxhash-recurse (cdr x) (1- depthoid))) 261835505))) (instance - (if (or (typep x 'structure-object) (typep x 'condition)) - (logxor 422371266 - (sxhash ; through DEFTRANSFORM - (classoid-name - (layout-classoid (%instance-layout x))))) - (sxhash-instance x))) + (if (pathnamep x) + ;; Pathnames are EQUAL if all the components are EQUAL, so + ;; we hash all of the components of a pathname together. + (let ((hash (sxhash-recurse (pathname-host x) depthoid))) + (mixf hash (sxhash-recurse (pathname-device x) depthoid)) + (mixf hash (sxhash-recurse (pathname-directory x) depthoid)) + (mixf hash (sxhash-recurse (pathname-name x) depthoid)) + (mixf hash (sxhash-recurse (pathname-type x) depthoid)) + ;; Hash :NEWEST the same as NIL because EQUAL for + ;; pathnames assumes that :newest and nil are equal. + (let ((version (%pathname-version x))) + (mixf hash (sxhash-recurse (if (eq version :newest) + nil + version) + depthoid)))) + (if (or (typep x 'structure-object) (typep x 'condition)) + (logxor 422371266 + (sxhash ; through DEFTRANSFORM + (classoid-name + (layout-classoid (%instance-layout x))))) + (sxhash-instance x)))) (symbol (sxhash x)) ; through DEFTRANSFORM (array (typecase x @@ -212,11 +213,10 @@ ;; 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 - (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 +249,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 +264,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)) @@ -339,8 +351,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)