1.0.48.31: WITH-LOCKED-SYSTEM-TABLE

  Instead of disabling interrupts in user code that needs
  WITH-LOCKED-HASH-TABLE, have a separate WITH-LOCKED-SYSTEM-TABLE
  that does so.

  Use it instead of WITH-LOCKED-HASH-TABLE for all internals.

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index 568e844..c7fc14f 100644 (file)
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -902,7 +902,7 @@ Experimental: interface subject to change."
                (funcall fun part))))
       (when ext
         (let ((table sb-pcl::*eql-specializer-table*))
-          (call (sb-ext:with-locked-hash-table (table)
+          (call (sb-int:with-locked-system-table (table)
                   (gethash object table)))))
       (etypecase object
         ((or bignum float sb-sys:system-area-pointer fixnum))

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 1dc2002..b77f7de 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -852,6 +852,9 @@ possibly temporariliy, because it might be used internally."
                ;; Stack allocation without any questions asked
                "TRULY-DYNAMIC-EXTENT"
 
+               ;; Like WITH-LOCKED-HASH-TABLE, but disabled interrupts
+               "WITH-LOCKED-SYSTEM-TABLE"
+
                ;; generic set implementation
                "ADD-TO-XSET"
                "ALLOC-XSET"

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 0db908d..38fbef0 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -705,7 +705,7 @@
 (defun find-classoid-cell (name &key create errorp)
   (let ((table *classoid-cells*)
         (real-name (uncross name)))
-    (or (with-locked-hash-table (table)
+    (or (with-locked-system-table (table)
           (or (gethash real-name table)
               (when create
                 (setf (gethash real-name table) (make-classoid-cell real-name)))))
@@ -827,7 +827,7 @@
 (defun insured-find-classoid (name predicate constructor)
   (declare (type function predicate constructor))
   (let ((table *forward-referenced-layouts*))
-    (with-locked-hash-table (table)
+    (with-locked-system-table (table)
       (let* ((old (find-classoid name nil))
              (res (if (and old (funcall predicate old))
                       old

diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp
index 597756a..70d6f35 100644 (file)
--- a/src/code/cross-misc.lisp
+++ b/src/code/cross-misc.lisp
@@ -39,6 +39,10 @@
   (declare (ignore table))
   `(progn ,@body))
 
+(defmacro with-locked-system-table ((table) &body body)
+  (declare (ignore table))
+  `(progn ,@body))
+
 (defmacro defglobal (name value &rest doc)
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      (defparameter ,name

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index b37c0c0..9b973c0 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -309,7 +309,7 @@
 ;;; and retains roots to functions that might otherwise be collected.
 (defun make-compiled-debug-fun (compiler-debug-fun component)
   (let ((table *compiled-debug-funs*))
-    (with-locked-hash-table (table)
+    (with-locked-system-table (table)
       (or (gethash compiler-debug-fun table)
           (setf (gethash compiler-debug-fun table)
                 (%make-compiled-debug-fun compiler-debug-fun component))))))

diff --git a/src/code/dyncount.lisp b/src/code/dyncount.lisp
index c9270dc..befac9f 100644 (file)
--- a/src/code/dyncount.lisp
+++ b/src/code/dyncount.lisp
@@ -37,7 +37,7 @@ comments from CMU CL:
   "Return a hash-table containing only the entries in Table1 whose key is not
    also a key in Table2." (declare (type hash-table table1 table2))
   (let ((res (make-hash-table-like table1)))
-    (with-locked-hash-table (table2)
+    (with-locked-system-table (table2)
       (dohash ((k v) table1 :locked t)
         (unless (nth-value 1 (gethash k table2))
           (setf (gethash k res) v))))

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index c589ab9..5f2aa46 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -461,7 +461,7 @@
                              ,@forms)))))
         `(let ((,n-table ,table))
            ,(if locked
-                `(with-locked-hash-table (,n-table)
+                `(with-locked-system-table (,n-table)
                    ,iter-form)
                 iter-form))))))
 \f

diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp
index d72595c..933b390 100644 (file)
--- a/src/code/hash-table.lisp
+++ b/src/code/hash-table.lisp
@@ -144,6 +144,10 @@ unspecified."
   ;; Needless to say, this also excludes some internal bits, but
   ;; getting there is too much detail when "unspecified" says what
   ;; is important -- unpredictable, but harmless.
+  `(sb!thread::with-recursive-spinlock ((hash-table-spinlock ,hash-table))
+     ,@body))
+
+(defmacro-mundanely with-locked-system-table ((hash-table) &body body)
   `(sb!thread::with-recursive-system-spinlock
        ((hash-table-spinlock ,hash-table))
      ,@body))

diff --git a/src/code/linkage-table.lisp b/src/code/linkage-table.lisp
index 6a4a70c..61e21b5 100644 (file)
--- a/src/code/linkage-table.lisp
+++ b/src/code/linkage-table.lisp
@@ -60,7 +60,7 @@
 ;;; in the linkage table.
 (defun ensure-foreign-symbol-linkage (name datap)
   (/show0 "ensure-foreign-symbol-linkage")
-  (with-locked-hash-table (*linkage-info*)
+  (with-locked-system-table (*linkage-info*)
     (let ((info (or (gethash (cons name datap) *linkage-info*)
                     (link-foreign-symbol name datap))))
       (linkage-info-address info))))

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index 1d74e47..ec90233 100644 (file)
--- a/src/code/ntrace.lisp
+++ b/src/code/ntrace.lisp
@@ -660,7 +660,7 @@ are evaluated in the null environment."
       ((not fun)
        ;; Someone has FMAKUNBOUND it.
        (let ((table *traced-funs*))
-         (with-locked-hash-table (table)
+         (with-locked-system-table (table)
            (maphash (lambda (fun info)
                       (when (equal function-or-name (trace-info-what info))
                         (remhash fun table)))

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 3f9bb9a..4569a11 100644 (file)
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -75,7 +75,7 @@
 
 (defmacro with-package-names ((names &key) &body body)
   `(let ((,names *package-names*))
-     (with-locked-hash-table (,names)
+     (with-locked-system-table (,names)
        ,@body)))
 \f
 ;;;; PACKAGE-HASHTABLE stuff

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index 52e81dc..ff023ee 100644 (file)
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -1361,7 +1361,7 @@ unspecified elements into a completed to-pathname based on the to-wildname."
 ;;; a new one if necessary.
 (defun intern-logical-host (thing)
   (declare (values logical-host))
-  (with-locked-hash-table (*logical-hosts*)
+  (with-locked-system-table (*logical-hosts*)
     (or (find-logical-host thing nil)
         (let* ((name (logical-word-or-lose thing))
                (new (make-logical-host :name name)))

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 21f0eb8..e7e825d 100644 (file)
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -595,7 +595,7 @@
 (defun intern-eql-specializer (object)
   ;; Need to lock, so that two threads don't get non-EQ specializers
   ;; for an EQL object.
-  (with-locked-hash-table (*eql-specializer-table*)
+  (with-locked-system-table (*eql-specializer-table*)
     (or (gethash object *eql-specializer-table*)
         (setf (gethash object *eql-specializer-table*)
               (make-instance 'eql-specializer :object object)))))

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index be3c163..86019d2 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -1579,7 +1579,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
     nil))
 \f
 ;;; Not synchronized, as all the uses we have for it are multiple ones
-;;; and need WITH-LOCKED-HASH-TABLE in any case.
+;;; and need WITH-LOCKED-SYSTEM-TABLE in any case.
 ;;;
 ;;; FIXME: Is it really more efficient to store this stuff in a global
 ;;; table instead of having a slot in each method?
@@ -1590,7 +1590,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
 
 (defun flush-effective-method-cache (generic-function)
   (let ((cache *effective-method-cache*))
-    (with-locked-hash-table (cache)
+    (with-locked-system-table (cache)
       (dolist (method (generic-function-methods generic-function))
         (remhash method cache)))))
 
@@ -1615,7 +1615,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
           (call-no-applicable-method gf args)))
       (let* ((key (car methods))
              (ht *effective-method-cache*)
-             (ht-value (with-locked-hash-table (ht)
+             (ht-value (with-locked-system-table (ht)
                          (or (gethash key ht)
                              (setf (gethash key ht) (cons nil nil))))))
         (if (and (null (cdr methods)) all-applicable-p ; the most common case

diff --git a/src/pcl/fngen.lisp b/src/pcl/fngen.lisp
index 548974a..4df2a35 100644 (file)
--- a/src/pcl/fngen.lisp
+++ b/src/pcl/fngen.lisp
@@ -89,7 +89,7 @@
 (defvar *fgens* (make-hash-table :test #'equal :synchronized t))
 
 (defun ensure-fgen (test gensyms generator generator-lambda system)
-  (with-locked-hash-table (*fgens*)
+  (with-locked-system-table (*fgens*)
     (let ((old (lookup-fgen test)))
       (cond (old
              (setf (fgen-generator old) generator)
@@ -164,7 +164,7 @@
 \f
 (defmacro precompile-function-generators (&optional system)
   (let (collect)
-    (with-locked-hash-table (*fgens*)
+    (with-locked-system-table (*fgens*)
       (maphash (lambda (test fgen)
                  (when (or (null (fgen-system fgen))
                            (eq (fgen-system fgen) system))

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index 8a7b123..5b6d913 100644 (file)
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -66,7 +66,7 @@
   (let ((type (slot-definition-type slotd)))
     (values
      (when (and (neq t type) (safe-p (slot-definition-class slotd)))
-       (with-locked-hash-table (**typecheck-cache**)
+       (with-locked-system-table (**typecheck-cache**)
          (or (gethash type **typecheck-cache**)
              (setf (gethash type **typecheck-cache**)
                    (handler-bind (((or style-warning compiler-note)

diff --git a/version.lisp-expr b/version.lisp-expr
index deb1ff9..cb5efe2 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.48.30"
+"1.0.48.31"