1.0.6.34: AVER that the GF lock is held during SET-DFUN

 ...and adjust commentary in UPDATE-DFUN.

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index c8f9912..526229f 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -2090,10 +2090,15 @@ bootstrapping.
   (let ((new-state (if (and dfun (or cache info))
                        (list* dfun cache info)
                        dfun)))
-    (if (eq *boot-state* 'complete)
-        (setf (safe-gf-dfun-state gf) new-state)
-        (setf (clos-slots-ref (get-slots gf) *sgf-dfun-state-index*)
-              new-state)))
+    (cond
+      ((eq *boot-state* 'complete)
+       ;; Check that we are under the lock.
+       #+sb-thread
+       (aver (eq sb-thread:*current-thread* (sb-thread::spinlock-value (gf-lock gf))))
+       (setf (safe-gf-dfun-state gf) new-state))
+      (t
+       (setf (clos-slots-ref (get-slots gf) *sgf-dfun-state-index*)
+             new-state))))
   dfun)
 
 (defun gf-dfun-cache (gf)

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 5ed2026..6fc21e6 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -1752,13 +1752,13 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
       ;; a generic can cause the dispatch function to be updated we
       ;; need a lock here.
       ;;
-      ;; We need to accept recursion, because PCL is nasty and twisty.
+      ;; We need to accept recursion, because PCL is nasty and twisty,
+      ;; and we need to disable interrupts because it would be bad if
+      ;; we updated the DFUN-STATE but not the dispatch function.
       ;;
-      ;; KLUDGE: We need to disable interrupts as long as
-      ;; WITH-FOO-LOCK is interrupt unsafe. Once they are interrupt
-      ;; safe we can allow interrupts here. (But if someone some day
-      ;; manages to get rid of the need for a recursive lock here we
-      ;; _will_ need without-interrupts once again.)
+      ;; This is sufficient, because all the other calls to SET-DFUN
+      ;; are part of this same code path (done while the lock is held),
+      ;; which we AVER.
       ;;
       ;; FIXME: When our mutexes are smart about the need to wake up
       ;; sleepers we can put a mutex here instead -- but in the meantime
@@ -1767,9 +1767,14 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
       ;; KLUDGE: No need to lock during bootstrap.
       (if early-p
           (update)
-          (sb-sys:without-interrupts
-            (sb-thread::with-recursive-spinlock ((gf-lock generic-function))
-              (update)))))))
+          (let ((lock (gf-lock generic-function)))
+            ;; FIXME: GF-LOCK is a generic function... Are there cases
+            ;; where we can end up in a metacircular loop here? In
+            ;; case there are, better fetch it while interrupts are
+            ;; still enabled...
+            (sb-sys:without-interrupts
+              (sb-thread::with-recursive-spinlock (lock)
+                (update))))))))
 \f
 (defvar *dfun-count* nil)
 (defvar *dfun-list* nil)

diff --git a/version.lisp-expr b/version.lisp-expr
index 2b5f12f..aaccc48 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,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.6.33"
+"1.0.6.34"