(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
;;; 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)))
\f
;;;; hashing strings
;;;;
;;;; <http://burtleburtle.net/bob/hash/doobs.html> 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
;;;; 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
(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
;; 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))))))
(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)
projects / sbcl.git / blobdiff