0.8.12.32: Fix the performance degradation in DEFCLASS caused

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

diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp
index facc633..c2b7027 100644 (file)
--- a/src/code/sxhash.lisp
+++ b/src/code/sxhash.lisp
@@ -17,15 +17,16 @@
 ;;; 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))))))))
 (deftransform sxhash ((x) (double-float))
-  '(let* ((val x)
-         (hi (double-float-high-bits val))
+  '(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
@@ -38,8 +39,8 @@
 ;;; 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
+          (logxor (ash (logand x (ash most-positive-fixnum -4)) 4)
+                  (logand (ash x -1) most-positive-fixnum) ; to get sign bit into hash
                   361475658)))
 
 ;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
@@ -67,7 +68,6 @@
                                '(- 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))
@@ -75,7 +75,6 @@
                                 '(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))
@@ -98,12 +97,24 @@
 ;;; 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))
+      ;; 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))))