X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sxhash.lisp;h=2e0e06ab93a4113cddd6afbb349fc2be9cc14de8;hb=a01e7ac2e8a9f3afae8f759381a0829fceb5bfde;hp=dbe9d23de5549e818ba013102813c697b8479be3;hpb=5a9b7fcee7cd5374010d7a5b05463b84abc35079;p=sbcl.git diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index dbe9d23..2e0e06a 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -40,6 +40,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, @@ -143,20 +144,6 @@ (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))) - (defun sxhash (x) ;; profiling SXHASH is hard, but we might as well try to make it go ;; fast, in case it is the bottleneck somewhere. -- CSR, 2003-03-14 @@ -215,8 +202,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 +235,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 +250,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))