0.9.3.66:

[sbcl.git] / src / code / target-thread.lisp

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index da38ee8..f4e9fc6 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -549,18 +549,20 @@ won't like the effect."
   #!-sb-thread
   (funcall function)
   #!+sb-thread
-  (let ((function (coerce function 'function)))
-    (multiple-value-bind (res err)
-        ;; protect against gcing just when the ub32 address is ready
-        ;; to be passed to C
-        (sb!sys::with-pinned-objects (function)
-          (sb!unix::syscall ("interrupt_thread"
-                             system-area-pointer sb!alien:unsigned-long)
-                            thread
-                            (thread-%sap thread)
-                            (sb!kernel:get-lisp-obj-address function)))
-      (unless res
-        (error 'interrupt-thread-error :thread thread :errno err)))))
+  (if (eq thread *current-thread*)
+      (funcall function)
+      (let ((function (coerce function 'function)))
+        (multiple-value-bind (res err)
+            ;; protect against gcing just when the ub32 address is
+            ;; just ready to be passed to C
+            (sb!sys::with-pinned-objects (function)
+              (sb!unix::syscall ("interrupt_thread"
+                                 system-area-pointer sb!alien:unsigned-long)
+                                thread
+                                (thread-%sap thread)
+                                (sb!kernel:get-lisp-obj-address function)))
+          (unless res
+            (error 'interrupt-thread-error :thread thread :errno err))))))
 
 (defun terminate-thread (thread)
   #!+sb-doc