X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdfun.lisp;h=3be7f774be1cc42f6edf9ee579dac791de2f9b14;hb=7d853ed1882221bc790062e423a74a620f6e4ee1;hp=5ed20267daeb7eac6ba15e7a953085aab07c2242;hpb=968bb35fbaf4d60b63fa6967bc36029bd5b12701;p=sbcl.git

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 5ed2026..3be7f77 100644
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -260,8 +260,8 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
 ;;;     This is the most general case. In this case, the accessor
 ;;;     generic function has seen more than one class of argument and
 ;;;     more than one slot index. A cache vector stores the wrappers
-;;;     and corresponding slot indexes. Because each cache line is
-;;;     more than one element long, a cache lock count is used.
+;;;     and corresponding slot indexes.
+
 (defstruct (dfun-info (:constructor nil)
                       (:copier nil))
   (cache nil))
@@ -1664,7 +1664,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                                             all-applicable-p
                                             (all-sorted-p t)
                                             function-p)
-  (if (null methods)
+   (if (null methods)
       (if function-p
           (lambda (method-alist wrappers)
             (declare (ignore method-alist wrappers))
@@ -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,12 @@ 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-thread::call-with-recursive-system-spinlock #'update lock))))))
 
 (defvar *dfun-count* nil)
 (defvar *dfun-list* nil)
@@ -1779,7 +1782,6 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
 ;;; I'm aware of, but they look like they might be useful for
 ;;; debugging or performance tweaking or something, so I've just
 ;;; commented them out instead of deleting them. -- WHN 2001-03-28
-#|
 (defun list-dfun (gf)
   (let* ((sym (type-of (gf-dfun-info gf)))
          (a (assq sym *dfun-list*)))
@@ -1842,7 +1844,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
           (format t "~%   ~S~%" (caddr type+count+sizes)))
         *dfun-count*)
   (values))
-|#
+||#
 
 (defun gfs-of-type (type)
   (unless (consp type) (setq type (list type)))