0.8.10.32:

[sbcl.git] / src / code / sxhash.lisp

diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp
index 61f4d29..39ccc47 100644 (file)
--- a/src/code/sxhash.lisp
+++ b/src/code/sxhash.lisp
@@ -17,14 +17,15 @@
 ;;; SXHASH of FLOAT values is defined directly in terms of DEFTRANSFORM in
 ;;; order to avoid boxing.
 (deftransform sxhash ((x) (single-float))
-  '(let ((bits (single-float-bits x)))
+  '(let* ((val (+ 0.0f0 x))
+         (bits (single-float-bits val)))
      (logxor 66194023
             (sxhash (the fixnum
                          (logand most-positive-fixnum
                                  (logxor bits
                                          (ash bits -7))))))))
 (deftransform sxhash ((x) (double-float))
-  '(let* ((val x)
+  '(let* ((val (+ 0.0d0 x))
          (hi (double-float-high-bits val))
          (lo (double-float-low-bits val))
          (hilo (logxor hi lo)))
@@ -47,34 +48,46 @@
 (deftransform sxhash ((x) (simple-bit-vector))
   `(let ((result 410823708))
     (declare (type fixnum result))
-    (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 (+ sb!vm:vector-data-offset
-                 (ceiling (length x) sb!vm:n-word-bits))))
-        ((= i end) result)
-      (declare (type index i end))
-      (let ((num
-            (if (= i (1- end))
-                (logand
-                 (ash (1- (ash 1 (mod (length x) sb!vm:n-word-bits)))
-                      ,(ecase sb!c:*backend-byte-order*
-                         (:little-endian 0)
-                         (:big-endian
-                          '(- sb!vm:n-word-bits
-                              (mod (length x) sb!vm:n-word-bits)))))
-                 (%raw-bits x i))
-                (%raw-bits x i))))
-       (declare (type (unsigned-byte 32) num))
-       (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)))))))))
+    (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))))
+                (declare (type (unsigned-byte 32) num))
+                (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)))
+            (declare (type (unsigned-byte 32) num))
+            (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.
@@ -86,12 +99,12 @@
 ;;; easily do this optimization in the cross-compiler, and SBCL itself
 ;;; doesn't seem to need this optimization, so we don't try.
 (deftransform sxhash ((x) (simple-string))
-  (if #+sb-xc-host nil #-sb-xc-host (constant-continuation-p x)
-      (sxhash (continuation-value x))
+  (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
+      (sxhash (lvar-value x))
       '(%sxhash-simple-string x)))
 (deftransform sxhash ((x) (symbol))
-  (if #+sb-xc-host nil #-sb-xc-host (constant-continuation-p x)
-      (sxhash (continuation-value x))
+  (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
+      (sxhash (lvar-value x))
       '(%sxhash-simple-string (symbol-name x))))