X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sxhash.lisp;h=35fdcdce89fb66509bfab67ad9a07c639952b861;hb=7cca1cabd213d38218a40e973b06ca11c8546396;hp=3df7c3d7172467405e5ef36e48039bf197d71ca7;hpb=b870615b146940f661e5d0e9069ca4e16e9f483d;p=sbcl.git diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index 3df7c3d..35fdcdc 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -36,9 +36,10 @@ ;;; * We'd like this to be simple and fast, too. ;;; ;;; FIXME: Should this be INLINE? -(declaim (ftype (function ((and fixnum unsigned-byte) - (and fixnum unsigned-byte)) - (and fixnum unsigned-byte)) mix)) +(declaim (ftype (sfunction ((and fixnum unsigned-byte) + (and fixnum unsigned-byte)) + (and fixnum unsigned-byte)) + 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, @@ -63,33 +64,45 @@ ;; algorithms, but we're not pushing them hard enough here for them ;; to be cryptographically strong.) (let* ((xy (+ (* x 3) y))) - (declare (type (unsigned-byte 32) xy)) - (the (and fixnum unsigned-byte) - (logand most-positive-fixnum - (logxor 441516657 - xy - (the fixnum (ash xy -5))))))) + (logand most-positive-fixnum + (logxor 441516657 + xy + (ash xy -5))))) ;;;; hashing strings ;;;; -;;;; Note that this operation is used in compiler symbol table lookups, so we'd -;;;; like it to be fast. +;;;; Note that this operation is used in compiler symbol table +;;;; lookups, so we'd like it to be fast. +;;;; +;;;; As of 2004-03-10, we implement the one-at-a-time algorithm +;;;; designed by Bob Jenkins (see +;;;; for some more +;;;; information). #!-sb-fluid (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 sbcl-0.5.0m. + ;; cross-compiler were smarter about ASH, but we need it for + ;; sbcl-0.5.0m. (probably no longer true? We might need SAFETY 0 + ;; to elide some type checks, but then again if this is inlined in + ;; all the critical places, we might not -- CSR, 2004-03-10) (declare (optimize (speed 3) (safety 0))) (declare (type string string)) (declare (type index count)) - (let ((result 408967240)) - (declare (type fixnum result)) - (dotimes (i count) - (declare (type index i)) - (mixf result - (the fixnum - (ash (char-code (aref string i)) 5)))) - result)) + (macrolet ((set-result (form) + `(setf result (ldb (byte #.sb!vm:n-word-bits 0) ,form)))) + (let ((result 0)) + (declare (type (unsigned-byte #.sb!vm:n-word-bits) result)) + (unless (typep string '(vector nil)) + (dotimes (i count) + (declare (type index i)) + (set-result (+ result (char-code (aref string i)))) + (set-result (+ result (ash result 10))) + (set-result (logxor result (ash result -6))))) + (set-result (+ result (ash result 3))) + (set-result (logxor result (ash result -11))) + (set-result (logxor result (ash result 15))) + (logand result most-positive-fixnum)))) ;;; test: ;;; (let ((ht (make-hash-table :test 'equal))) ;;; (do-all-symbols (symbol) @@ -104,16 +117,32 @@ (defun %sxhash-simple-string (x) (declare (optimize speed)) (declare (type simple-string x)) - (%sxhash-substring x)) + ;; KLUDGE: this FLET is a workaround (suggested by APD) for presence + ;; of let conversion in the cross compiler, which otherwise causes + ;; strongly suboptimal register allocation. + (flet ((trick (x) + (%sxhash-substring x))) + (declare (notinline trick)) + (trick x))) (defun %sxhash-simple-substring (x count) (declare (optimize speed)) (declare (type simple-string x)) (declare (type index count)) - (%sxhash-substring x count)) + ;; see comment in %SXHASH-SIMPLE-STRING + (flet ((trick (x count) + (%sxhash-substring x count))) + (declare (notinline trick)) + (trick x count))) ;;;; 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)) + (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 @@ -135,16 +164,24 @@ (mixf result (sxhash-number (realpart x))) (mixf result (sxhash-number (imagpart x))) result)))) - (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+)) + (sxhash-recurse (x depthoid) (declare (type index depthoid)) (typecase x - (cons - (if (plusp depthoid) - (mix (sxhash-recurse (car x) (1- depthoid)) - (sxhash-recurse (cdr x) (1- depthoid))) - 261835505)) + ;; we test for LIST here, rather than CONS, because the + ;; type test for CONS is in fact the test for + ;; LIST-POINTER-LOWTAG followed by a negated test for + ;; NIL. If we're going to have to test for NIL anyway, + ;; we might as well do it explicitly and pick off the + ;; answer. -- CSR, 2004-07-14 + (list + (if (null x) + (sxhash x) ; through DEFTRANSFORM + (if (plusp depthoid) + (mix (sxhash-recurse (car x) (1- depthoid)) + (sxhash-recurse (cdr x) (1- depthoid))) + 261835505))) (instance - (if (typep x 'structure-object) + (if (or (typep x 'structure-object) (typep x 'condition)) (logxor 422371266 (sxhash ; through DEFTRANSFORM (classoid-name @@ -172,7 +209,7 @@ (number (sxhash-number x)) (generic-function (sxhash-instance x)) (t 42)))) - (sxhash-recurse x))) + (sxhash-recurse x +max-hash-depthoid+))) ;;;; the PSXHASH function