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 ((bits (single-float-bits x)))
23 (logand most-positive-fixnum
26 (deftransform sxhash ((x) (double-float))
28 (hi (double-float-high-bits val))
29 (lo (double-float-low-bits val))
30 (hilo (logxor hi lo)))
33 (logand most-positive-fixnum
37 ;;; SXHASH of FIXNUM values is defined as a DEFTRANSFORM because it's so
39 (deftransform sxhash ((x) (fixnum))
40 '(logand most-positive-fixnum
41 (logxor (ash (logand x (ash most-positive-fixnum -4)) 4)
42 (ash x -1) ; to get sign bit into hash
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)))
55 (do* ((i sb!vm:vector-data-offset (+ i 1))
56 ;; FIXME: should we respect DEPTHOID? SXHASH on
57 ;; strings doesn't seem to...
58 (end-1 (+ sb!vm:vector-data-offset
59 (floor (1- length) sb!vm:n-word-bits))))
63 (ash (1- (ash 1 (mod length sb!vm:n-word-bits)))
64 ,(ecase sb!c:*backend-byte-order*
68 (mod length sb!vm:n-word-bits)))))
70 (declare (type (unsigned-byte 32) num))
71 (mix result ,(ecase sb!c:*backend-byte-order*
73 '(logand num most-positive-fixnum))
75 '(ash num (- sb!vm:n-lowtag-bits)))))))
76 (declare (type index i end-1))
77 (let ((num (%raw-bits x i)))
78 (declare (type (unsigned-byte 32) num))
79 (mixf result ,(ecase sb!c:*backend-byte-order*
81 '(logand num most-positive-fixnum))
82 ;; FIXME: I'm not certain that
83 ;; N-LOWTAG-BITS is the clearest way of
84 ;; expressing this: it's essentially the
85 ;; difference between `(UNSIGNED-BYTE
86 ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM
89 '(ash num (- sb!vm:n-lowtag-bits))))))))))))
91 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
92 ;;; order to avoid having to do TYPECASE at runtime.
94 ;;; We also take the opportunity to handle the cases of constant
95 ;;; strings, and of symbols whose names are known at compile time;
96 ;;; except that since SXHASH on the cross-compilation host is not in
97 ;;; general compatible with SXHASH on the target SBCL, we can't so
98 ;;; easily do this optimization in the cross-compiler, and SBCL itself
99 ;;; doesn't seem to need this optimization, so we don't try.
100 (deftransform sxhash ((x) (simple-string))
101 (if #+sb-xc-host nil #-sb-xc-host (constant-continuation-p x)
102 (sxhash (continuation-value x))
103 '(%sxhash-simple-string x)))
104 (deftransform sxhash ((x) (symbol))
105 (if #+sb-xc-host nil #-sb-xc-host (constant-continuation-p x)
106 (sxhash (continuation-value x))
107 '(%sxhash-simple-string (symbol-name x))))