1 ;;;; that part of SXHASH logic which runs not only in the target Lisp but
2 ;;;; in the cross-compilation host Lisp
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
15 (sb!xc
:define-modify-macro mixf
(y) mix
)
17 ;;; SXHASH of FLOAT values is defined directly in terms of DEFTRANSFORM in
18 ;;; order to avoid boxing.
19 (deftransform sxhash
((x) (single-float))
20 '(let* ((val (+ 0.0f0 x
))
21 (bits (logand (single-float-bits val
) #.
(1- (ash 1 32)))))
24 (logand most-positive-fixnum
27 (deftransform sxhash
((x) (double-float))
28 '(let* ((val (+ 0.0d0 x
))
29 (hi (logand (double-float-high-bits val
) #.
(1- (ash 1 32))))
30 (lo (double-float-low-bits val
))
31 (hilo (logxor hi lo
)))
34 (logand most-positive-fixnum
38 ;;; SXHASH of FIXNUM values is defined as a DEFTRANSFORM because it's so
40 (deftransform sxhash
((x) (fixnum))
41 (let ((c (logand 1193941380939624010 sb
!xc
:most-positive-fixnum
)))
42 ;; shift by -1 to get sign bit into hash
43 `(logand (logxor (ash x
4) (ash x -
1) ,c
) sb
!xc
:most-positive-fixnum
)))
45 ;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
46 ;;; because it is endian-dependent.
47 (deftransform sxhash
((x) (simple-bit-vector))
48 `(let ((result 410823708)
50 (declare (type fixnum result
))
53 (mix result
(sxhash 0)))
55 (mixf result
(sxhash length
))
56 (multiple-value-bind (n-full-words n-bits-remaining
)
57 (floor length sb
!vm
:n-word-bits
)
58 (flet ((mix-into-result (num)
60 ,(ecase sb
!c
:*backend-byte-order
*
62 '(logand num most-positive-fixnum
))
63 ;; FIXME: I'm not certain that
64 ;; N-LOWTAG-BITS is the clearest way of
65 ;; expressing this: it's essentially the
66 ;; difference between `(UNSIGNED-BYTE
67 ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM
70 '(ash num
(- sb
!vm
:n-lowtag-bits
)))))))
71 (declare (inline mix-into-result
))
72 ;; FIXME: should we respect DEPTHOID? SXHASH on strings
74 (dotimes (i n-full-words
)
75 (mix-into-result (%vector-raw-bits x i
)))
76 (if (zerop n-bits-remaining
)
79 (logand (ash (1- (ash 1 n-bits-remaining
))
80 ,(ecase sb
!c
:*backend-byte-order
*
85 (%vector-raw-bits x n-full-words
))))))))))
87 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
88 ;;; order to avoid having to do TYPECASE at runtime.
90 ;;; We also take the opportunity to handle the cases of constant
91 ;;; strings, and of symbols whose names are known at compile time;
92 ;;; except that since SXHASH on the cross-compilation host is not in
93 ;;; general compatible with SXHASH on the target SBCL, we can't so
94 ;;; easily do this optimization in the cross-compiler, and SBCL itself
95 ;;; doesn't seem to need this optimization, so we don't try.
96 (deftransform sxhash
((x) (simple-string))
97 (if #+sb-xc-host nil
#-sb-xc-host
(constant-lvar-p x
)
98 (sxhash (lvar-value x
))
99 '(%sxhash-simple-string x
)))
100 (deftransform sxhash
((x) (symbol))
101 (if #+sb-xc-host nil
#-sb-xc-host
(constant-lvar-p x
)
102 (sxhash (lvar-value x
))
103 (if (csubtypep (lvar-type x
) (specifier-type 'null
))
104 ;; FIXME: this isn't in fact as optimized as it could be;
105 ;; this does a memory load, whereas (because we know the
106 ;; layout of NIL) we could simply take the address of NIL
107 ;; (or the contents of NULL-TN) and mask off the appropriate
108 ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which
109 ;; is NIL. -- CSR, 2004-07-14
111 ;; Cache the value of the symbol's sxhash in the symbol-hash
113 '(let ((result (symbol-hash x
)))
114 ;; 0 marks uninitialized slot. We can't use negative
115 ;; values for the uninitialized slots since NIL might be
116 ;; located so high in memory on some platforms that its
117 ;; SYMBOL-HASH (which contains NIL itself) is a negative
120 (ensure-symbol-hash x
)
123 (deftransform psxhash
((x &optional depthoid
) (character &optional t
))
124 `(char-code (char-upcase x
)))
126 (deftransform psxhash
((x &optional depthoid
) (integer &optional t
))