1.0.23.42: don't grab *WORLD-LOCK* in CLASSOID-TYPEP

 * A shoddy bandaid to make Slime less prone to deadlock against the
   compiler when using :SPAWN.

 * Proper fix is to be much, much more principled about grabbing the
   *WORLD-LOCK* in the compiler: we should only ever grab it in places
   where we cannot end up calling arbitary user code while holding
   it.

diff --git a/src/code/typep.lisp b/src/code/typep.lisp
index 2e65f03..43acfdf 100644 (file)
--- a/src/code/typep.lisp
+++ b/src/code/typep.lisp
@@ -178,20 +178,27 @@
 ;;; Test whether OBJ-LAYOUT is from an instance of CLASSOID.
 (defun classoid-typep (obj-layout classoid object)
   (declare (optimize speed))
-  (with-world-lock ()
-    (multiple-value-bind (obj-layout layout)
-        (do ((layout (classoid-layout classoid) (classoid-layout classoid))
-             (i 0 (+ i 1))
-             (obj-layout obj-layout))
-            ((and (not (layout-invalid obj-layout))
-                  (not (layout-invalid layout)))
-             (values obj-layout layout))
-          (aver (< i 2))
-          (when (layout-invalid obj-layout)
-            (setq obj-layout (update-object-layout-or-invalid object layout)))
-          (%ensure-classoid-valid classoid layout))
-      (let ((obj-inherits (layout-inherits obj-layout)))
-        (or (eq obj-layout layout)
-            (dotimes (i (length obj-inherits) nil)
-              (when (eq (svref obj-inherits i) layout)
-                (return t))))))))
+  ;; FIXME & KLUDGE: We could like to grab the *WORLD-LOCK* here (to ensure that
+  ;; class graph doesn't change while we're doing the typep test), but in
+  ;; pratice that causes trouble -- deadlocking against the compiler
+  ;; if compiler output (or macro, or compiler-macro expansion) causes
+  ;; another thread to do stuff. Not locking is a shoddy bandaid as it is remains
+  ;; easy to trigger the same problem using a different code path -- but in practice
+  ;; locking here makes Slime unusable with :SPAWN in post *WORLD-LOCK* world. So...
+  ;; -- NS 2008-12-16
+  (multiple-value-bind (obj-layout layout)
+      (do ((layout (classoid-layout classoid) (classoid-layout classoid))
+           (i 0 (+ i 1))
+           (obj-layout obj-layout))
+          ((and (not (layout-invalid obj-layout))
+                (not (layout-invalid layout)))
+           (values obj-layout layout))
+        (aver (< i 2))
+        (when (layout-invalid obj-layout)
+          (setq obj-layout (update-object-layout-or-invalid object layout)))
+        (%ensure-classoid-valid classoid layout))
+    (let ((obj-inherits (layout-inherits obj-layout)))
+      (or (eq obj-layout layout)
+          (dotimes (i (length obj-inherits) nil)
+            (when (eq (svref obj-inherits i) layout)
+              (return t)))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index bc122c8..429d58c 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.23.41"
+"1.0.23.42"