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 (single-float-bits val)))
24 (logand most-positive-fixnum
27 (deftransform sxhash ((x) (double-float))
28 '(let* ((val (+ 0.0d0 x))
29 (hi (double-float-high-bits val))
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 '(logand most-positive-fixnum
42 (logxor (ash (logand x (ash most-positive-fixnum -4)) 4)
43 (ash x -1) ; to get sign bit into hash
46 ;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
47 ;;; because it is endian-dependent.
48 (deftransform sxhash ((x) (simple-bit-vector))
49 `(let ((result 410823708))
50 (declare (type fixnum result))
51 (let ((length (length x)))
53 ((= length 0) (mix result (sxhash 0)))
55 (mixf result (sxhash (length x)))
56 (do* ((i sb!vm:vector-data-offset (+ i 1))
57 ;; FIXME: should we respect DEPTHOID? SXHASH on
58 ;; strings doesn't seem to...
59 (end-1 (+ sb!vm:vector-data-offset
60 (floor (1- length) sb!vm:n-word-bits))))
64 (ash (1- (ash 1 (mod length sb!vm:n-word-bits)))
65 ,(ecase sb!c:*backend-byte-order*
69 (mod length sb!vm:n-word-bits)))))
71 (declare (type (unsigned-byte 32) num))
72 (mix result ,(ecase sb!c:*backend-byte-order*
74 '(logand num most-positive-fixnum))
76 '(ash num (- sb!vm:n-lowtag-bits)))))))
77 (declare (type index i end-1))
78 (let ((num (%raw-bits x i)))
79 (declare (type (unsigned-byte 32) num))
80 (mixf result ,(ecase sb!c:*backend-byte-order*
82 '(logand num most-positive-fixnum))
83 ;; FIXME: I'm not certain that
84 ;; N-LOWTAG-BITS is the clearest way of
85 ;; expressing this: it's essentially the
86 ;; difference between `(UNSIGNED-BYTE
87 ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM
90 '(ash num (- sb!vm:n-lowtag-bits))))))))))))
92 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
93 ;;; order to avoid having to do TYPECASE at runtime.
95 ;;; We also take the opportunity to handle the cases of constant
96 ;;; strings, and of symbols whose names are known at compile time;
97 ;;; except that since SXHASH on the cross-compilation host is not in
98 ;;; general compatible with SXHASH on the target SBCL, we can't so
99 ;;; easily do this optimization in the cross-compiler, and SBCL itself
100 ;;; doesn't seem to need this optimization, so we don't try.
101 (deftransform sxhash ((x) (simple-string))
102 (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
103 (sxhash (lvar-value x))
104 '(%sxhash-simple-string x)))
105 (deftransform sxhash ((x) (symbol))
106 (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
107 (sxhash (lvar-value x))
108 ;; Cache the value of the symbol's sxhash in the symbol-hash slot.
109 '(let ((result (symbol-hash x)))
110 ;; 0 marks uninitialized slot. We can't use negative values
111 ;; for the uninitialized slots since NIL might be located so
112 ;; high in memory on some platforms that its SYMBOL-HASH
113 ;; (which contains NIL itself) is a negative fixnum.
115 (let ((sxhash (%sxhash-simple-string (symbol-name x))))
116 ;; We could do a (logor sxhash #x10000000) to ensure
117 ;; that we never store a 0 in the slot. However, it's
118 ;; such an unlikely event (1/5e8?) that it makes more
119 ;; sense to optimize for the common case...
120 (%set-symbol-hash x sxhash)