1.0.18.6: rename SB-PCL::FUNCTION-KEYWORD-PARAMETERS to CL:FUNCTION-KEYWORDS

[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 366ffdf..bdb5514 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)))
@@ -129,18 +113,19 @@
   (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
@@ -732,14 +717,14 @@ if there is no such entry. Entries can be added using SETF."
   (aver (hash-table-index-vector hash-table))
   (macrolet ((put-it (lockedp)
                `(let ((cache (hash-table-cache hash-table))
-        (kv-vector (hash-table-table hash-table)))
-    ;; Check the cache
-    (if (and cache
-             (< cache (length kv-vector))
-             (eq (aref kv-vector cache) key))
-        ;; If cached, just store here
-        (setf (aref kv-vector (1+ cache)) value)
-        ;; Otherwise do things the hard way
+                      (kv-vector (hash-table-table hash-table)))
+                  ;; Check the cache
+                  (if (and cache
+                           (< cache (length kv-vector))
+                           (eq (aref kv-vector cache) key))
+                      ;; If cached, just store here
+                      (setf (aref kv-vector (1+ cache)) value)
+                      ;; Otherwise do things the hard way
                       ,(if lockedp
                            '(%%puthash key hash-table value)
                            '(with-hash-table-locks
@@ -791,6 +776,8 @@ if there is no such entry. Entries can be added using SETF."
                (when hash-vector
                  (setf (aref hash-vector slot-location)
                        +magic-hash-vector-value+))
+               ;; On parallel accesses this may turn out to be a
+               ;; type-error, so don't turn down the safety!
                (decf (hash-table-number-entries hash-table))
                t))
         (cond ((zerop next)
@@ -941,16 +928,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))