From: David Lichteblau Date: Wed, 12 Dec 2012 13:30:52 +0000 (+0100) Subject: Foreign callbacks X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=daa6f0ce672d8dc60176ff885da18e44ee0355c6;p=sbcl.git Foreign callbacks Allow alien callbacks to be invoked in pthreads created outside of the Lisp runtime: Add new runtime functions attach_os_thread, detach_os_thread allowing such threads to acquire a `struct thread' temporarily, turning them into Lisp threads. In a main deviation from the Windows branch (which has a similar feature), this mechanism does not involve user-land thread (fiber) mechanisms to switch between stacks. Instead, Lisp code merely runs on the existing pthread's stack. Currently a safepoint-only feature, because only safepoint-based builds already go through a convenient trampoline function for callbacks, but a backport of this feature to non-safepoint builds might be straightforward. --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 8e96d24..03ab6ee 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2022,6 +2022,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "THREAD-EMPHEMERAL-P" "THREAD-NAME" "THREAD-YIELD" + "FOREIGN-THREAD" ;; Memory barrier "BARRIER" ;; Mutexes 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)) diff --git a/src/code/thread.lisp b/src/code/thread.lisp index e45fa64..2cfd567 100644 --- a/src/code/thread.lisp +++ b/src/code/thread.lisp @@ -35,6 +35,13 @@ in future versions." :type mutex) waiting-for) +(def!struct (foreign-thread + (:include thread) + (:conc-name "THREAD-")) + #!+sb-doc + "Type of native threads which are attached to the runtime as Lisp threads +temporarily.") + (def!struct mutex #!+sb-doc "Mutex type." diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp index abe0fba..ca556c2 100644 --- a/src/compiler/generic/parms.lisp +++ b/src/compiler/generic/parms.lisp @@ -123,7 +123,8 @@ sb!di::handle-single-step-trap fdefinition-object #!+win32 sb!kernel::handle-win32-exception - #!+sb-thruption sb!thread::run-interruption)) + #!+sb-thruption sb!thread::run-interruption + #!+sb-safepoint sb!thread::enter-foreign-callback)) (defparameter *common-static-symbols* '(t diff --git a/src/runtime/safepoint.c b/src/runtime/safepoint.c index 8a34a08..a9e578c 100644 --- a/src/runtime/safepoint.c +++ b/src/runtime/safepoint.c @@ -979,9 +979,17 @@ callback_wrapper_trampoline( #endif lispobj arg0, lispobj arg1, lispobj arg2) { +#if defined(LISP_FEATURE_WIN32) + pthread_np_notice_thread(); +#endif struct thread* th = arch_os_get_current_thread(); - if (!th) - lose("callback invoked in non-lisp thread. Sorry, that is not supported yet."); + if (!th) { /* callback invoked in non-lisp thread */ + init_thread_data scribble; + attach_os_thread(&scribble); + funcall3(StaticSymbolFunction(ENTER_FOREIGN_CALLBACK), arg0,arg1,arg2); + detach_os_thread(&scribble); + return; + } #ifdef LISP_FEATURE_WIN32 /* arg2 is the pointer to a return value, which sits on the stack */ diff --git a/src/runtime/thread.c b/src/runtime/thread.c index 053f486..4d20d0f 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -349,8 +349,9 @@ schedule_thread_post_mortem(struct thread *corpse) # endif /* !IMMEDIATE_POST_MORTEM */ +/* Note: scribble must be stack-allocated */ static void -init_new_thread(struct thread *th, init_thread_data *scribble) +init_new_thread(struct thread *th, init_thread_data *scribble, int guardp) { int lock_ret; @@ -361,7 +362,8 @@ init_new_thread(struct thread *th, init_thread_data *scribble) } th->os_thread=thread_self(); - protect_control_stack_guard_page(1, NULL); + if (guardp) + protect_control_stack_guard_page(1, NULL); protect_binding_stack_guard_page(1, NULL); protect_alien_stack_guard_page(1, NULL); /* Since GC can only know about this thread from the all_threads @@ -369,7 +371,7 @@ init_new_thread(struct thread *th, init_thread_data *scribble) * danger of deadlocking even with SIG_STOP_FOR_GC blocked (which * it is not). */ #ifdef LISP_FEATURE_SB_SAFEPOINT - *th->csp_around_foreign_call = (lispobj)&lock_ret; + *th->csp_around_foreign_call = (lispobj)scribble; #endif lock_ret = pthread_mutex_lock(&all_threads_lock); gc_assert(lock_ret == 0); @@ -449,6 +451,15 @@ undo_init_new_thread(struct thread *th, init_thread_data *scribble) TlsSetValue(OUR_TLS_INDEX,NULL); #endif + /* Undo the association of the current pthread to its `struct thread', + * such that we can call arch_os_get_current_thread() later in this + * thread and cleanly get back NULL. */ +#ifdef LISP_FEATURE_GCC_TLS + current_thread = NULL; +#else + pthread_setspecific(specials, NULL); +#endif + schedule_thread_post_mortem(th); } @@ -471,7 +482,7 @@ new_thread_trampoline(struct thread *th) lispobj function = th->no_tls_value_marker; th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG; - init_new_thread(th, &scribble); + init_new_thread(th, &scribble, 1); result = funcall0(function); undo_init_new_thread(th, &scribble); @@ -479,6 +490,67 @@ new_thread_trampoline(struct thread *th) return result; } +# ifdef LISP_FEATURE_SB_SAFEPOINT +static struct thread *create_thread_struct(lispobj); + +void +attach_os_thread(init_thread_data *scribble) +{ + os_thread_t os = pthread_self(); + odxprint(misc, "attach_os_thread: attaching to %p", os); + + struct thread *th = create_thread_struct(NIL); + block_deferrable_signals(0, &scribble->oldset); + th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG; + /* We don't actually want a pthread_attr here, but rather than add + * `if's to the post-mostem, let's just keep that code happy by + * keeping it initialized: */ + pthread_attr_init(th->os_attr); + +#ifndef LISP_FEATURE_WIN32 + /* On windows, arch_os_thread_init will take care of finding the + * stack. */ + pthread_attr_t attr; + int pthread_getattr_np(pthread_t, pthread_attr_t *); + pthread_getattr_np(os, &attr); + void *stack_addr; + size_t stack_size; + pthread_attr_getstack(&attr, &stack_addr, &stack_size); + th->control_stack_start = stack_addr; + th->control_stack_end = (void *) (((uintptr_t) stack_addr) + stack_size); +#endif + + init_new_thread(th, scribble, 0); + + /* We will be calling into Lisp soon, and the functions being called + * recklessly ignore the comment in target-thread which says that we + * must be careful to not cause GC while initializing a new thread. + * Since we first need to create a fresh thread object, it's really + * tempting to just perform such unsafe allocation though. So let's + * at least try to suppress GC before consing, and hope that it + * works: */ + SetSymbolValue(GC_INHIBIT, T, th); + + uword_t stacksize + = (uword_t) th->control_stack_end - (uword_t) th->control_stack_start; + odxprint(misc, "attach_os_thread: attached %p as %p (0x%lx bytes stack)", + os, th, (long) stacksize); +} + +void +detach_os_thread(init_thread_data *scribble) +{ + struct thread *th = arch_os_get_current_thread(); + odxprint(misc, "detach_os_thread: detaching"); + + undo_init_new_thread(th, scribble); + + odxprint(misc, "deattach_os_thread: detached"); + pthread_setspecific(lisp_thread, (void *)0); + thread_sigmask(SIG_SETMASK, &scribble->oldset, 0); +} +# endif /* safepoint */ + #endif /* LISP_FEATURE_SB_THREAD */ static void diff --git a/src/runtime/thread.h b/src/runtime/thread.h index dd36df5..8bde9ba 100644 --- a/src/runtime/thread.h +++ b/src/runtime/thread.h @@ -338,10 +338,10 @@ extern kern_return_t mach_lisp_thread_destroy(struct thread *thread); #endif typedef struct init_thread_data { + sigset_t oldset; #ifdef LISP_FEATURE_SB_SAFEPOINT struct gcing_safety safety; #endif - void *dummy; } init_thread_data; #ifdef LISP_FEATURE_SB_SAFEPOINT @@ -419,6 +419,9 @@ void pop_gcing_safety(struct gcing_safety *from) int check_pending_thruptions(os_context_t *ctx); +void attach_os_thread(init_thread_data *); +void detach_os_thread(init_thread_data *); + #endif extern void create_initial_thread(lispobj);