X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsxhash.lisp;h=8b13e798d14521a1b3c52713948e62d6b60e16a0;hb=2912f5f6c2acb2da3b9fcc0f5afd1ca89782a9f8;hp=0621486f68d0623821eda86342b9d884e49ddf32;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp
index 0621486..8b13e79 100644
--- a/src/code/sxhash.lisp
+++ b/src/code/sxhash.lisp
@@ -38,13 +38,72 @@
 ;;; simple.
 (deftransform sxhash ((x) (fixnum))
   '(logand most-positive-fixnum
-	   (logxor x
-		   (ash x -3) ; to get sign bit into hash
+	   (logxor (ash (logand x (ash most-positive-fixnum -4)) 4) 
+		   (ash x -1) ; to get sign bit into hash
 		   361475658)))
 
-;;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in order to
-;;;; avoid having to do TYPECASE at runtime.
+;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
+;;; because it is endian-dependent.
+(deftransform sxhash ((x) (simple-bit-vector))
+  `(let ((result 410823708))
+    (declare (type fixnum result))
+    (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.
+;;;
+;;; We also take the opportunity to handle the cases of constant
+;;; strings, and of symbols whose names are known at compile time;
+;;; except that since SXHASH on the cross-compilation host is not in
+;;; general compatible with SXHASH on the target SBCL, we can't so
+;;; 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))
-  '(%sxhash-simple-string 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))
-  '(%sxhash-simple-string (symbol-name x)))
+  (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
+      (sxhash (lvar-value x))
+      '(%sxhash-simple-string (symbol-name x))))
+
+