X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=80e3fee033462296f2641166714154efc441f8ab;hb=829ced3e78a23ba153ba4db64e6ea6984c2313b6;hp=c668eeacdcf1c8a50d64e7f698e348182e8946c7;hpb=789406b1a4f6d546f426eb4f51aa6a10d432c4dd;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index c668eea..80e3fee 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -1351,7 +1351,7 @@ have the foreground next."
 
 #!+sb-thread
 (defun initial-thread-function-trampoline
-    (thread setup-sem real-function arguments)
+    (thread setup-sem real-function arguments arg1 arg2 arg3)
   ;; In time we'll move some of the binding presently done in C here
   ;; too.
   ;;
@@ -1388,7 +1388,7 @@ have the foreground next."
       (with-session-lock (*session*)
         (push thread (session-threads *session*)))
       (setf (thread-%alive-p thread) t)
-      (signal-semaphore setup-sem)
+      (when setup-sem (signal-semaphore setup-sem))
       ;; Using handling-end-of-the-world would be a bit tricky
       ;; due to other catches and interrupts, so we essentially
       ;; re-implement it here. Once and only once more.
@@ -1400,14 +1400,17 @@ have the foreground next."
               (without-interrupts
                   (unwind-protect
                        (with-local-interrupts
-                           (sb!unix::unblock-deferrable-signals)
+                         (setf *gc-inhibit* nil) ;for foreign callbacks
+                         (sb!unix::unblock-deferrable-signals)
                          (setf (thread-result thread)
                                (prog1
                                    (cons t
                                          (multiple-value-list
                                           (unwind-protect
                                                (catch '%return-from-thread
-                                                 (apply real-function arguments))
+                                                 (if (listp arguments)
+                                                     (apply real-function arguments)
+                                                     (funcall real-function arg1 arg2 arg3)))
                                             (when *exit-in-process*
                                               (sb!impl::call-exit-hooks)))))
                                  #!+sb-safepoint
@@ -1457,7 +1460,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
                  ;; As it is, this lambda must not cons until we are ready
                  ;; to run GC. Be very careful.
                  (initial-thread-function-trampoline
-                  thread setup-sem real-function arguments))))
+                  thread setup-sem real-function arguments nil nil nil))))
          ;; If the starting thread is stopped for gc before it signals the
          ;; semaphore then we'd be stuck.
          (assert (not *gc-inhibit*))
@@ -1514,6 +1517,12 @@ subject to change."
   "Deprecated. Same as TERMINATE-THREAD."
   (terminate-thread thread))
 
+#!+sb-safepoint
+(defun enter-foreign-callback (arg1 arg2 arg3)
+  (initial-thread-function-trampoline
+   (make-foreign-thread :name "foreign callback")
+   nil #'sb!alien::enter-alien-callback t arg1 arg2 arg3))
+
 (defmacro with-interruptions-lock ((thread) &body body)
   `(with-system-mutex ((thread-interruptions-lock ,thread))
      ,@body))