1.0.18.7: just one POWER-OF-TWO-CEILING, thank you

[sbcl.git] / src / code / target-hash-table.lisp

diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp
index 1389875..2a92616 100644 (file)
--- a/src/code/target-hash-table.lisp
+++ b/src/code/target-hash-table.lisp
@@ -14,9 +14,6 @@
 \f
 ;;;; utilities
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant max-hash sb!xc:most-positive-fixnum))
-
 ;;; Code for detecting concurrent accesses to the same table from
 ;;; multiple threads. Only compiled in when the :SB-HASH-TABLE-DEBUG
 ;;; feature is enabled. The main reason for the existence of this code
@@ -74,19 +71,6 @@
                    (setf (,thread-slot-accessor ,hash-table) nil)))
                (body-fun)))))))
 
-(deftype hash ()
-  `(integer 0 ,max-hash))
-
-;;; FIXME: Does this always make a nonnegative FIXNUM? If so, then
-;;; explain why. If not (or if the reason it always makes a
-;;; nonnegative FIXNUM is only the accident that pointers in supported
-;;; architectures happen to be in the lower half of the address
-;;; space), then fix it.
-#!-sb-fluid (declaim (inline pointer-hash))
-(defun pointer-hash (key)
-  (declare (values hash))
-  (truly-the hash (%primitive sb!c:make-fixnum key)))
-
 #!-sb-fluid (declaim (inline eq-hash))
 (defun eq-hash (key)
   (declare (values hash (member t nil)))
@@ -124,23 +108,20 @@
     (t
      (eq-hash key))))
 
-(defun ceil-power-of-two (num)
-  (declare (type index num))
-  (ash 1 (integer-length num)))
-
 (declaim (inline index-for-hashing))
-(defun index-for-hashing (index length)
-  (declare (type index index length))
+(defun index-for-hashing (hash length)
+  (declare (type hash hash length))
   ;; We're using power of two tables which obviously are very
   ;; sensitive to the exact values of the low bits in the hash
   ;; value. Do a little shuffling of the value to mix the high bits in
   ;; there too.
-  (logand (1- length)
-          (+ (logxor #b11100101010001011010100111
-                     index)
-             (ash index -6)
-             (ash index -15)
-             (ash index -23))))
+  (truly-the index
+             (logand (1- length)
+                     (+ (logxor #b11100101010001011010100111
+                                hash)
+                        (ash hash -3)
+                        (ash hash -12)
+                        (ash hash -20)))))
 
 \f
 ;;;; user-defined hash table tests
@@ -249,8 +230,8 @@
            ;; Note that this has not yet been audited for
            ;; correctness. It just seems to work. -- CSR, 2002-11-02
            (scaled-size (truncate (/ (float size+1) rehash-threshold)))
-           (length (ceil-power-of-two (max scaled-size
-                                           (1+ +min-hash-table-size+))))
+           (length (power-of-two-ceiling (max scaled-size
+                                              (1+ +min-hash-table-size+))))
            (index-vector (make-array length
                                      :element-type
                                      '(unsigned-byte #.sb!vm:n-word-bits)
@@ -341,7 +322,7 @@ multiple threads accessing the same hash-table without locking."
          (old-hash-vector (hash-table-hash-vector table))
          (old-size (length old-next-vector))
          (new-size
-          (ceil-power-of-two
+          (power-of-two-ceiling
            (let ((rehash-size (hash-table-rehash-size table)))
              (etypecase rehash-size
                (fixnum
@@ -943,16 +924,16 @@ to protect the MAPHASH call."
   (cond ((or (not *print-readably*) (not *read-eval*))
          (print-unreadable-object (hash-table stream :type t :identity t)
            (format stream
-                   ":TEST ~S :COUNT ~S"
+                   ":TEST ~S :COUNT ~S~@[ :WEAKNESS ~S~]"
                    (hash-table-test hash-table)
-                   (hash-table-count hash-table))))
+                   (hash-table-count hash-table)
+                   (hash-table-weakness hash-table))))
         (t
-         (with-standard-io-syntax
-          (format stream
-                  "#.~W"
-                  `(%stuff-hash-table (make-hash-table ,@(%hash-table-ctor-args
+         (write-string "#." stream)
+         (write `(%stuff-hash-table (make-hash-table ,@(%hash-table-ctor-args
                                                           hash-table))
-                                     ',(%hash-table-alist hash-table)))))))
+                                     ',(%hash-table-alist hash-table))
+                :stream stream))))
 
 (def!method make-load-form ((hash-table hash-table) &optional environment)
   (declare (ignore environment))