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))
49 (declare (type fixnum result
))
50 (let ((length (length x
)))
52 ((= length
0) (mix result
(sxhash 0)))
54 (mixf result
(sxhash (length x
)))
56 ;; FIXME: should we respect DEPTHOID? SXHASH on
57 ;; strings doesn't seem to...
58 (end-1 (floor (1- length
) sb
!vm
:n-word-bits
)))
62 (ash (1- (ash 1 (mod length sb
!vm
:n-word-bits
)))
63 ,(ecase sb
!c
:*backend-byte-order
*
67 (mod length sb
!vm
:n-word-bits
)))))
68 (%vector-raw-bits x i
))))
69 (mix result
,(ecase sb
!c
:*backend-byte-order
*
71 '(logand num most-positive-fixnum
))
73 '(ash num
(- sb
!vm
:n-lowtag-bits
)))))))
74 (declare (type index i end-1
))
75 (let ((num (%vector-raw-bits x i
)))
76 (mixf result
,(ecase sb
!c
:*backend-byte-order
*
78 '(logand num most-positive-fixnum
))
79 ;; FIXME: I'm not certain that
80 ;; N-LOWTAG-BITS is the clearest way of
81 ;; expressing this: it's essentially the
82 ;; difference between `(UNSIGNED-BYTE
83 ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM
86 '(ash num
(- sb
!vm
:n-lowtag-bits
))))))))))))
88 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
89 ;;; order to avoid having to do TYPECASE at runtime.
91 ;;; We also take the opportunity to handle the cases of constant
92 ;;; strings, and of symbols whose names are known at compile time;
93 ;;; except that since SXHASH on the cross-compilation host is not in
94 ;;; general compatible with SXHASH on the target SBCL, we can't so
95 ;;; easily do this optimization in the cross-compiler, and SBCL itself
96 ;;; doesn't seem to need this optimization, so we don't try.
97 (deftransform sxhash
((x) (simple-string))
98 (if #+sb-xc-host nil
#-sb-xc-host
(constant-lvar-p x
)
99 (sxhash (lvar-value x
))
100 '(%sxhash-simple-string x
)))
101 (deftransform sxhash
((x) (symbol))
102 (if #+sb-xc-host nil
#-sb-xc-host
(constant-lvar-p x
)
103 (sxhash (lvar-value x
))
104 (if (csubtypep (lvar-type x
) (specifier-type 'null
))
105 ;; FIXME: this isn't in fact as optimized as it could be;
106 ;; this does a memory load, whereas (because we know the
107 ;; layout of NIL) we could simply take the address of NIL
108 ;; (or the contents of NULL-TN) and mask off the appropriate
109 ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which
110 ;; is NIL. -- CSR, 2004-07-14
112 ;; Cache the value of the symbol's sxhash in the symbol-hash
114 '(let ((result (symbol-hash x
)))
115 ;; 0 marks uninitialized slot. We can't use negative
116 ;; values for the uninitialized slots since NIL might be
117 ;; located so high in memory on some platforms that its
118 ;; SYMBOL-HASH (which contains NIL itself) is a negative
121 (ensure-symbol-hash x
)
124 (deftransform psxhash
((x &optional depthoid
) (character &optional t
))
125 `(char-code (char-upcase x
)))
127 (deftransform psxhash
((x &optional depthoid
) (integer &optional t
))