1.0.5.2: non-racy WITH-SPINLOCK-AND-WITHOUT-GCING

[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 8865c5a..2011304 100644 (file)
--- a/src/code/target-hash-table.lisp
+++ b/src/code/target-hash-table.lisp
@@ -14,26 +14,22 @@
 \f
 ;;;; utilities
 
-;; This stuff is performance critical and unwind-protect is too
-;; slow. And without the locking the next vector can get cyclic
-;; causing looping in a WITHOUT-GCING form, SHRINK-VECTOR can corrupt
-;; memory and who knows what else.
+;;; Without the locking the next vector can get cyclic causing
+;;; looping in a WITHOUT-GCING form, SHRINK-VECTOR can corrupt memory
+;;; and who knows what else.
+;;;
+;;; WITHOUT-GCING implies WITHOUT-INTERRUPTS.
 (defmacro with-spinlock-and-without-gcing ((spinlock) &body body)
   #!-sb-thread
   (declare (ignore spinlock))
-  (with-unique-names (old-gc-inhibit)
-    `(let ((,old-gc-inhibit *gc-inhibit*)
-           (*gc-inhibit* t))
+  `(without-gcing
        (unwind-protect
             (progn
               #!+sb-thread
               (sb!thread::get-spinlock ,spinlock)
               ,@body)
          #!+sb-thread
-         (sb!thread::release-spinlock ,spinlock)
-         (let ((*gc-inhibit* ,old-gc-inhibit))
-           ;; the test is racy, but it can err only on the overeager side
-           (sb!kernel::maybe-handle-pending-gc))))))
+         (sb!thread::release-spinlock ,spinlock))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant max-hash sb!xc:most-positive-fixnum))
@@ -60,7 +56,16 @@
 #!-sb-fluid (declaim (inline equal-hash))
 (defun equal-hash (key)
   (declare (values hash (member t nil)))
-  (values (sxhash key) nil))
+  (typecase key
+    ;; For some types the definition of EQUAL implies a special hash
+    ((or string cons number bit-vector pathname)
+     (values (sxhash key) nil))
+    ;; Otherwise use an EQ hash, rather than SXHASH, since the values
+    ;; of SXHASH will be extremely badly distributed due to the
+    ;; requirements of the spec fitting badly with our implementation
+    ;; strategy.
+    (t
+     (eq-hash key))))
 
 #!-sb-fluid (declaim (inline eql-hash))
 (defun eql-hash (key)
@@ -71,7 +76,13 @@
 
 (defun equalp-hash (key)
   (declare (values hash (member t nil)))
-  (values (psxhash key) nil))
+  (typecase key
+    ;; Types requiring special treatment. Note that PATHNAME and
+    ;; HASH-TABLE are caught by the STRUCTURE-OBJECT test.
+    ((or array cons number character structure-object)
+     (values (psxhash key) nil))
+    (t
+     (eq-hash key))))
 
 (defun almost-primify (num)
   (declare (type index num))