;;; * 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,
\f
;;;; 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
+;;;; <http://burtleburtle.net/bob/hash/doobs.html> 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))
- (unless (typep string '(vector nil))
- (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)
(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)))
\f
;;;; 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
(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 (or (typep x 'structure-object) (typep x 'condition))
(logxor 422371266
(number (sxhash-number x))
(generic-function (sxhash-instance x))
(t 42))))
- (sxhash-recurse x)))
+ (sxhash-recurse x +max-hash-depthoid+)))
\f
;;;; the PSXHASH function
(name (classoid-name classoid))
(result (mix (sxhash name) (the fixnum 79867))))
(declare (type fixnum result))
- (dotimes (i (min depthoid (1- length)))
+ (dotimes (i (min depthoid (- length 1 (layout-n-untagged-slots layout))))
(declare (type fixnum i))
(let ((j (1+ i))) ; skipping slot #0, which is for LAYOUT
(declare (type fixnum j))
(mixf result
(psxhash (%instance-ref key j)
(1- depthoid)))))
+ ;; KLUDGE: Should hash untagged slots, too. (Although +max-hash-depthoid+
+ ;; is pretty low currently, so they might not make it into the hash
+ ;; value anyway.)
result))
(defun list-psxhash (key depthoid)
projects / sbcl.git / blobdiff