;;; 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)))
+ (logxor (ash (logand x (ash most-positive-fixnum -4)) 4)
+ (logand (ash x -1) most-positive-fixnum) ; to get sign bit into hash
+ 361475658)))
;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
;;; because it is endian-dependent.
(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 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))))))))))))
;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
;;; order to avoid having to do TYPECASE at runtime.
(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)))))
projects / sbcl.git / blobdiff