? contrib/sb-simple-streams/test-data.tmp
Index: src/code/target-sxhash.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-sxhash.lisp,v
retrieving revision 1.20
diff -u -r1.20 target-sxhash.lisp
--- src/code/target-sxhash.lisp 6 Jan 2005 12:47:59 -0000 1.20
+++ src/code/target-sxhash.lisp 26 Jan 2005 18:27:10 -0000
@@ -40,34 +40,71 @@
(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,
- ;; 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.)
+ ;; Algorithm from .
+ ;; See also .
+
+ ;; The following is a leftover comment from the original
+ ;; implementation. This is still probably true, though I didn't test
+ ;; it and simply left in all the same declarations.
+
+ ;; ;; 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 (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).
- ;; * 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.
- ;; (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)))))
+ ;; This uses Alexey Dejneka's FLET trick to disable LET conversion
+ ;; so that we get good register allocation.
+ (flet ((trick (x y)
+ (macrolet ((u-word (param)
+ `(logand #.(1- (expt 2 sb!vm:n-word-bits))
+ ,param))
+ (u-word- (&rest params)
+ `(u-word (- ,@params)))
+ (u-word-shift (param shft)
+ `(u-word (ash ,param ,shft)))
+ (calc (v1 v2 v3 shft)
+ `(setf ,v1 (logxor (u-word- ,v1 ,v2 ,v3)
+ (u-word-shift ,v3 ,shft)))))
+ (let ((a #x9e3779b9) ; The golden ratio. Completely
+ ; arbitrary bit-pattern.
+ (b x)
+ (c y))
+ (declare (type (unsigned-byte #.sb!vm:n-word-bits) a b c))
+ #-#.(cl:if (cl:= sb!vm:n-word-bits 64) '(and) '(or))
+ (progn
+ (calc a b c -13)
+ (calc b c a 8)
+ (calc c a b -13)
+ (calc a b c -12)
+ (calc b c a 16)
+ (calc c a b -5)
+ (calc a b c -3)
+ (calc b c a 10)
+ (calc c a b -15))
+ #+#.(cl:if (cl:= sb!vm:n-word-bits 64) '(and) '(or))
+ (progn
+ (calc a b c -43)
+ (calc b c a 9)
+ (calc c a b -8)
+ (calc a b c -38)
+ (calc b c a 23)
+ (calc c a b -5)
+ (calc a b c -35)
+ (calc b c a 49)
+ (calc c a b -11)
+ (calc a b c -12)
+ (calc b c a 18)
+ (calc c a b -22))
+ (the fixnum (logand most-positive-fixnum c))))))
+ (declare (notinline trick))
+ (trick x y)))
+
;;;; hashing strings
;;;;