X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsxhash.lisp;h=39ccc477573e9284def10432db9bc117413da4b8;hb=add57c72c932fbf70c8ba8297154936c908b410e;hp=61f4d299706547e80969e550186bf1d927bb7792;hpb=a3ab89c1db0dd9bfb911532ca134be16f16c4c1b;p=sbcl.git

diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp
index 61f4d29..39ccc47 100644
--- 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))))