1.0.5.6: compare-and-swap / instance-set-conditional refactoring

[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 d6c7560..79a9cbd 100644 (file)
--- a/src/code/target-hash-table.lisp
+++ b/src/code/target-hash-table.lisp
@@ -14,30 +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 old-interrupts-enabled)
-    `(let ((,old-gc-inhibit *gc-inhibit*)
-           (,old-interrupts-enabled *interrupts-enabled*)
-           (*interrupts-enabled* nil)
-           (*gc-inhibit* t))
-       (unwind-protect
-            (progn
-              #!+sb-thread
-              (sb!thread::get-spinlock ,spinlock)
-              ,@body)
-         #!+sb-thread
-         (sb!thread::release-spinlock ,spinlock)
-         (let ((*interrupts-enabled* ,old-interrupts-enabled)
-               (*gc-inhibit* ,old-gc-inhibit))
-           ;; the test is racy, but it can err only on the overeager
-           ;; side
-           (sb!kernel::maybe-handle-pending-gc))))))
+  `(without-gcing
+     (unwind-protect
+          (progn
+            #!+sb-thread
+            (sb!thread::get-spinlock ,spinlock)
+            ,@body)
+       #!+sb-thread
+       (sb!thread::release-spinlock ,spinlock))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant max-hash sb!xc:most-positive-fixnum))
@@ -84,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))