(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
(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,
;;;; <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
- ;; 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
(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))))))
(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)
'(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
(let ((result 60828))
(declare (type fixnum result))
- (dotimes (i (min depthoid (array-rank key)))
+ (dotimes (i (array-rank key))
(mixf result (array-dimension key i)))
- (dotimes (i (min depthoid (array-total-size key)))
- (mixf result
- (psxhash (row-major-aref key i)
- (- depthoid 1 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)
(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)