X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsxhash.lisp;h=6b09f004a8e8cf8ab3db021da263b7cfc7be1912;hb=HEAD;hp=facc63398d56591e760cf72dc34c128f776512f4;hpb=8fb02633217a721b85487531709779f338d02438;p=sbcl.git

diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp
index facc633..6b09f00 100644
--- a/src/code/sxhash.lisp
+++ b/src/code/sxhash.lisp
@@ -17,30 +17,30 @@
 ;;; 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 (logand (single-float-bits val) #.(1- (ash 1 32)))))
      (logxor 66194023
-	     (sxhash (the fixnum
-			  (logand most-positive-fixnum
-				  (logxor bits
-					  (ash bits -7))))))))
+             (sxhash (the fixnum
+                          (logand most-positive-fixnum
+                                  (logxor bits
+                                          (ash bits -7))))))))
 (deftransform sxhash ((x) (double-float))
-  '(let* ((val x)
-	  (hi (double-float-high-bits val))
-	  (lo (double-float-low-bits val))
-	  (hilo (logxor hi lo)))
+  '(let* ((val (+ 0.0d0 x))
+          (hi (logand (double-float-high-bits val) #.(1- (ash 1 32))))
+          (lo (double-float-low-bits val))
+          (hilo (logxor hi lo)))
      (logxor 475038542
-	     (sxhash (the fixnum
-			  (logand most-positive-fixnum
-				  (logxor hilo
-					  (ash hilo -7))))))))
+             (sxhash (the fixnum
+                          (logand most-positive-fixnum
+                                  (logxor hilo
+                                          (ash hilo -7))))))))
 
 ;;; SXHASH of FIXNUM values is defined as a DEFTRANSFORM because it's so
 ;;; simple.
 (deftransform sxhash ((x) (fixnum))
-  '(logand most-positive-fixnum
-	   (logxor (ash (logand x (ash most-positive-fixnum -4)) 4) 
-		   (ash x -1) ; to get sign bit into hash
-		   361475658)))
+  (let ((c (logand 1193941380939624010 sb!xc:most-positive-fixnum)))
+    ;; shift by -1 to get sign bit into hash
+    `(logand (logxor (ash x 4) (ash x -1) ,c) sb!xc:most-positive-fixnum)))
 
 ;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
 ;;; because it is endian-dependent.
@@ -49,44 +49,41 @@
     (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))))))))))))
+        ((= length 0) (mix result (sxhash 0)))
+        (t
+         (mixf result (sxhash (length x)))
+         (do* ((i 0 (+ i 1))
+               ;; FIXME: should we respect DEPTHOID?  SXHASH on
+               ;; strings doesn't seem to...
+               (end-1 (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)))))
+                       (%vector-raw-bits x i))))
+                 (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 (%vector-raw-bits x i)))
+             (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.
@@ -98,12 +95,41 @@
 ;;; 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))
-      '(%sxhash-simple-string (symbol-name x))))
+  (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
+      (sxhash (lvar-value x))
+      (if (csubtypep (lvar-type x) (specifier-type 'null))
+          ;; FIXME: this isn't in fact as optimized as it could be;
+          ;; this does a memory load, whereas (because we know the
+          ;; layout of NIL) we could simply take the address of NIL
+          ;; (or the contents of NULL-TN) and mask off the appropriate
+          ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which
+          ;; is NIL.  -- CSR, 2004-07-14
+          '(symbol-hash x)
+          ;; Cache the value of the symbol's sxhash in the symbol-hash
+          ;; slot.
+          '(let ((result (symbol-hash x)))
+            ;; 0 marks uninitialized slot. We can't use negative
+            ;; values for the uninitialized slots since NIL might be
+            ;; located so high in memory on some platforms that its
+            ;; SYMBOL-HASH (which contains NIL itself) is a negative
+            ;; fixnum.
+            (if (= 0 result)
+                (let ((sxhash (%sxhash-simple-string (symbol-name x))))
+                  ;; We could do a (logior sxhash #x10000000) to
+                  ;; ensure that we never store a 0 in the
+                  ;; slot. However, it's such an unlikely event
+                  ;; (1/5e8?) that it makes more sense to optimize for
+                  ;; the common case...
+                  (%set-symbol-hash x sxhash)
+                  sxhash)
+                result)))))
 
+(deftransform psxhash ((x &optional depthoid) (character &optional t))
+  `(char-code (char-upcase x)))
 
+(deftransform psxhash ((x &optional depthoid) (integer &optional t))
+  `(sxhash x))