X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsxhash.lisp;h=6b09f004a8e8cf8ab3db021da263b7cfc7be1912;hb=HEAD;hp=2afbee678b51527c61a51c6eabb34e03704009e5;hpb=59ac7389b0bead82dfe2c94a5edab79dc9569c61;p=sbcl.git diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp index 2afbee6..6b09f00 100644 --- a/src/code/sxhash.lisp +++ b/src/code/sxhash.lisp @@ -18,30 +18,29 @@ ;;; order to avoid boxing. (deftransform sxhash ((x) (single-float)) '(let* ((val (+ 0.0f0 x)) - (bits (logand (single-float-bits val) #.(1- (ash 1 32))))) + (bits (logand (single-float-bits val) #.(1- (ash 1 32))))) (logxor 66194023 - (sxhash (the fixnum - (logand most-positive-fixnum - (logxor bits - (ash bits -7)))))))) + (sxhash (the fixnum + (logand most-positive-fixnum + (logxor bits + (ash bits -7)))))))) (deftransform sxhash ((x) (double-float)) '(let* ((val (+ 0.0d0 x)) - (hi (logand (double-float-high-bits val) #.(1- (ash 1 32)))) - (lo (double-float-low-bits val)) - (hilo (logxor hi lo))) + (hi (logand (double-float-high-bits val) #.(1- (ash 1 32)))) + (lo (double-float-low-bits val)) + (hilo (logxor hi lo))) (logxor 475038542 - (sxhash (the fixnum - (logand most-positive-fixnum - (logxor hilo - (ash hilo -7)))))))) + (sxhash (the fixnum + (logand most-positive-fixnum + (logxor hilo + (ash hilo -7)))))))) ;;; SXHASH of FIXNUM values is defined as a DEFTRANSFORM because it's so ;;; simple. (deftransform sxhash ((x) (fixnum)) - '(logand most-positive-fixnum - (logxor (ash (logand x (ash most-positive-fixnum -4)) 4) - (logand (ash x -1) most-positive-fixnum) ; to get sign bit into hash - 361475658))) + (let ((c (logand 1193941380939624010 sb!xc:most-positive-fixnum))) + ;; shift by -1 to get sign bit into hash + `(logand (logxor (ash x 4) (ash x -1) ,c) sb!xc:most-positive-fixnum))) ;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM ;;; because it is endian-dependent. @@ -50,42 +49,41 @@ (declare (type fixnum result)) (let ((length (length x))) (cond - ((= length 0) (mix result (sxhash 0))) - (t - (mixf result (sxhash (length x))) - (do* ((i sb!vm:vector-data-offset (+ i 1)) - ;; FIXME: should we respect DEPTHOID? SXHASH on - ;; strings doesn't seem to... - (end-1 (+ sb!vm:vector-data-offset - (floor (1- length) sb!vm:n-word-bits)))) - ((= i end-1) - (let ((num - (logand - (ash (1- (ash 1 (mod length sb!vm:n-word-bits))) - ,(ecase sb!c:*backend-byte-order* - (:little-endian 0) - (:big-endian - '(- sb!vm:n-word-bits - (mod length sb!vm:n-word-bits))))) - (%raw-bits x i)))) - (mix result ,(ecase sb!c:*backend-byte-order* - (:little-endian - '(logand num most-positive-fixnum)) - (:big-endian - '(ash num (- sb!vm:n-lowtag-bits))))))) - (declare (type index i end-1)) - (let ((num (%raw-bits x i))) - (mixf result ,(ecase sb!c:*backend-byte-order* - (:little-endian - '(logand num most-positive-fixnum)) - ;; FIXME: I'm not certain that - ;; N-LOWTAG-BITS is the clearest way of - ;; expressing this: it's essentially the - ;; difference between `(UNSIGNED-BYTE - ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM - ;; UNSIGNED-BYTE). - (:big-endian - '(ash num (- sb!vm:n-lowtag-bits)))))))))))) + ((= length 0) (mix result (sxhash 0))) + (t + (mixf result (sxhash (length x))) + (do* ((i 0 (+ i 1)) + ;; FIXME: should we respect DEPTHOID? SXHASH on + ;; strings doesn't seem to... + (end-1 (floor (1- length) sb!vm:n-word-bits))) + ((= i end-1) + (let ((num + (logand + (ash (1- (ash 1 (mod length sb!vm:n-word-bits))) + ,(ecase sb!c:*backend-byte-order* + (:little-endian 0) + (:big-endian + '(- sb!vm:n-word-bits + (mod length sb!vm:n-word-bits))))) + (%vector-raw-bits x i)))) + (mix result ,(ecase sb!c:*backend-byte-order* + (:little-endian + '(logand num most-positive-fixnum)) + (:big-endian + '(ash num (- sb!vm:n-lowtag-bits))))))) + (declare (type index i end-1)) + (let ((num (%vector-raw-bits x i))) + (mixf result ,(ecase sb!c:*backend-byte-order* + (:little-endian + '(logand num most-positive-fixnum)) + ;; FIXME: I'm not certain that + ;; N-LOWTAG-BITS is the clearest way of + ;; expressing this: it's essentially the + ;; difference between `(UNSIGNED-BYTE + ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM + ;; UNSIGNED-BYTE). + (:big-endian + '(ash num (- sb!vm:n-lowtag-bits)))))))))))) ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in ;;; order to avoid having to do TYPECASE at runtime. @@ -104,28 +102,34 @@ (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x) (sxhash (lvar-value x)) (if (csubtypep (lvar-type x) (specifier-type 'null)) - ;; FIXME: this isn't in fact as optimized as it could be; - ;; this does a memory load, whereas (because we know the - ;; layout of NIL) we could simply take the address of NIL - ;; (or the contents of NULL-TN) and mask off the appropriate - ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which - ;; is NIL. -- CSR, 2004-07-14 - '(symbol-hash x) - ;; Cache the value of the symbol's sxhash in the symbol-hash - ;; slot. - '(let ((result (symbol-hash x))) - ;; 0 marks uninitialized slot. We can't use negative - ;; values for the uninitialized slots since NIL might be - ;; located so high in memory on some platforms that its - ;; SYMBOL-HASH (which contains NIL itself) is a negative - ;; fixnum. - (if (= 0 result) - (let ((sxhash (%sxhash-simple-string (symbol-name x)))) - ;; We could do a (logior sxhash #x10000000) to - ;; ensure that we never store a 0 in the - ;; slot. However, it's such an unlikely event - ;; (1/5e8?) that it makes more sense to optimize for - ;; the common case... - (%set-symbol-hash x sxhash) - sxhash) - result))))) + ;; FIXME: this isn't in fact as optimized as it could be; + ;; this does a memory load, whereas (because we know the + ;; layout of NIL) we could simply take the address of NIL + ;; (or the contents of NULL-TN) and mask off the appropriate + ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which + ;; is NIL. -- CSR, 2004-07-14 + '(symbol-hash x) + ;; Cache the value of the symbol's sxhash in the symbol-hash + ;; slot. + '(let ((result (symbol-hash x))) + ;; 0 marks uninitialized slot. We can't use negative + ;; values for the uninitialized slots since NIL might be + ;; located so high in memory on some platforms that its + ;; SYMBOL-HASH (which contains NIL itself) is a negative + ;; fixnum. + (if (= 0 result) + (let ((sxhash (%sxhash-simple-string (symbol-name x)))) + ;; We could do a (logior sxhash #x10000000) to + ;; ensure that we never store a 0 in the + ;; slot. However, it's such an unlikely event + ;; (1/5e8?) that it makes more sense to optimize for + ;; the common case... + (%set-symbol-hash x sxhash) + sxhash) + result))))) + +(deftransform psxhash ((x &optional depthoid) (character &optional t)) + `(char-code (char-upcase x))) + +(deftransform psxhash ((x &optional depthoid) (integer &optional t)) + `(sxhash x))