1.0.23.37: more CLOS and classoid thread safety

[sbcl.git] / src / code / typep.lisp

diff --git a/src/code/typep.lisp b/src/code/typep.lisp
index bcc2934..2e65f03 100644 (file)
--- a/src/code/typep.lisp
+++ b/src/code/typep.lisp
@@ -178,19 +178,20 @@
 ;;; Test whether OBJ-LAYOUT is from an instance of CLASSOID.
 (defun classoid-typep (obj-layout classoid object)
   (declare (optimize speed))
-  (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)))))))
+  (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))))))))