X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsxhash.lisp;h=6b09f004a8e8cf8ab3db021da263b7cfc7be1912;hb=82cd148d729c241e79c8df04b700beec1b7c55de;hp=0621486f68d0623821eda86342b9d884e49ddf32;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp index 0621486..6b09f00 100644 --- a/src/code/sxhash.lisp +++ b/src/code/sxhash.lisp @@ -17,34 +17,119 @@ ;;; SXHASH of FLOAT values is defined directly in terms of DEFTRANSFORM in ;;; order to avoid boxing. (deftransform sxhash ((x) (single-float)) - '(let ((bits (single-float-bits x))) + '(let* ((val (+ 0.0f0 x)) + (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 x) - (hi (double-float-high-bits val)) - (lo (double-float-low-bits val)) - (hilo (logxor hi lo))) + '(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))) (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 x - (ash x -3) ; 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))) -;;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in order to -;;;; avoid having to do TYPECASE at runtime. +;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM +;;; because it is endian-dependent. +(deftransform sxhash ((x) (simple-bit-vector)) + `(let ((result 410823708)) + (declare (type fixnum result)) + (let ((length (length x))) + (cond + ((= 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. +;;; +;;; We also take the opportunity to handle the cases of constant +;;; strings, and of symbols whose names are known at compile time; +;;; except that since SXHASH on the cross-compilation host is not in +;;; general compatible with SXHASH on the target SBCL, we can't so +;;; easily do this optimization in the cross-compiler, and SBCL itself +;;; doesn't seem to need this optimization, so we don't try. (deftransform sxhash ((x) (simple-string)) - '(%sxhash-simple-string x)) + (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x) + (sxhash (lvar-value x)) + '(%sxhash-simple-string x))) (deftransform sxhash ((x) (symbol)) - '(%sxhash-simple-string (symbol-name x))) + (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))))) + +(deftransform psxhash ((x &optional depthoid) (character &optional t)) + `(char-code (char-upcase x))) + +(deftransform psxhash ((x &optional depthoid) (integer &optional t)) + `(sxhash x))