don't close runtime dlhandle on Darwin
[sbcl.git] / src / runtime / safepoint.c
index 953b8e9..224643d 100644 (file)
 #include "interrupt.h"
 #include "lispregs.h"
 
-/* Temporarily, this macro is a wrapper for FSHOW_SIGNAL.  Ultimately,
- * it will be restored to its full win32 branch functionality, where it
- * provides a very useful tracing mechanism that is configurable at
- * runtime. */
-#define odxprint_show(what, fmt, args...)                       \
-     do {                                                       \
-         struct thread *__self = arch_os_get_current_thread();  \
-         FSHOW_SIGNAL((stderr, "[%p/%p:%s] " fmt "\n",          \
-                       __self,                                  \
-                       __self->os_thread,                       \
-                       #what,                                   \
-                       ##args));                                \
-     } while (0)
-
-#if QSHOW_SIGNALS
-# define odxprint odxprint_show
-#else
-# define odxprint(what, fmt, args...) do {} while (0)
-#endif
-
 #if !defined(LISP_FEATURE_WIN32)
 /* win32-os.c covers these, but there is no unixlike-os.c, so the normal
  * definition goes here.  Fixme: (Why) don't these work for Windows?
@@ -101,6 +81,104 @@ thread_may_gc()
                 SymbolTlValue(GC_PENDING, self) == NIL));
 }
 
+#ifdef LISP_FEATURE_SB_THRUPTION
+static inline int
+thread_may_thrupt(os_context_t *ctx)
+{
+    struct thread * self = arch_os_get_current_thread();
+    /* Thread may be interrupted if all of these are true:
+     * 1) Deferrables are unblocked in the context of the signal that
+     *    went into the safepoint.  -- Otherwise the surrounding code
+     *    didn't want to be interrupted by a signal, so presumably it didn't
+     *    want to be INTERRUPT-THREADed either.
+     *    (See interrupt_handle_pending for an exception.)
+     * 2) On POSIX: There is no pending signal.  This is important even
+     *    after checking the sigmask, since we could be in the
+     *    handle_pending trap following re-enabling of interrupts.
+     *    Signals are unblocked in that case, but the signal is still
+     *    pending; we want to run GC before handling the signal and
+     *    therefore entered this safepoint.  But the thruption would call
+     *    ALLOW-WITH-INTERRUPTS, and could re-enter the handle_pending
+     *    trap, leading to recursion.
+     * 3) INTERRUPTS_ENABLED is non-nil.
+     * 4) No GC pending; it takes precedence.
+     * Note that we are in a safepoint here, which is always outside of PA. */
+
+    if (SymbolValue(INTERRUPTS_ENABLED, self) == NIL)
+        return 0;
+
+    if (SymbolValue(GC_PENDING, self) != NIL)
+        return 0;
+
+    if (SymbolValue(STOP_FOR_GC_PENDING, self) != NIL)
+        return 0;
+
+#ifdef LISP_FEATURE_WIN32
+    if (deferrables_blocked_p(&self->os_thread->blocked_signal_set))
+        return 0;
+#else
+    /* ctx is NULL if the caller wants to ignore the sigmask. */
+    if (ctx && deferrables_blocked_p(os_context_sigmask_addr(ctx)))
+        return 0;
+    if (SymbolValue(INTERRUPT_PENDING, self) != NIL)
+        return 0;
+#endif
+
+    if (SymbolValue(RESTART_CLUSTERS, self) == NIL)
+        /* This special case prevents TERMINATE-THREAD from hitting
+         * during INITIAL-THREAD-FUNCTION before it's ready.  Curiously,
+         * deferrables are already unblocked there.  Further
+         * investigation may be in order. */
+        return 0;
+
+    return 1;
+}
+
+// returns 0 if skipped, 1 otherwise
+int
+check_pending_thruptions(os_context_t *ctx)
+{
+    struct thread *p = arch_os_get_current_thread();
+
+#ifdef LISP_FEATURE_WIN32
+    pthread_t pself = p->os_thread;
+    sigset_t oldset;
+    /* On Windows, wake_thread/kill_safely does not set THRUPTION_PENDING
+     * in the self-kill case; instead we do it here while also clearing the
+     * "signal". */
+    if (pself->pending_signal_set)
+        if (__sync_fetch_and_and(&pself->pending_signal_set,0))
+            SetSymbolValue(THRUPTION_PENDING, T, p);
+#endif
+
+    if (!thread_may_thrupt(ctx))
+        return 0;
+    if (SymbolValue(THRUPTION_PENDING, p) == NIL)
+        return 0;
+    SetSymbolValue(THRUPTION_PENDING, NIL, p);
+
+#ifdef LISP_FEATURE_WIN32
+    oldset = pself->blocked_signal_set;
+    pself->blocked_signal_set = deferrable_sigset;
+    if (ctx) fake_foreign_function_call(ctx);
+#else
+    sigset_t oldset;
+    block_deferrable_signals(0, &oldset);
+#endif
+
+    funcall0(StaticSymbolFunction(RUN_INTERRUPTION));
+
+#ifdef LISP_FEATURE_WIN32
+    if (ctx) undo_fake_foreign_function_call(ctx);
+    pself->blocked_signal_set = oldset;
+    if (ctx) ctx->sigmask = oldset;
+#else
+    pthread_sigmask(SIG_SETMASK, &oldset, 0);
+#endif
+    return 1;
+}
+#endif
+
 int
 on_stack_p(struct thread *th, void *esp)
 {
@@ -219,6 +297,10 @@ struct gc_dispatcher {
        work without thundering herd. */
     int stopped;
 
+    /* Thruption flag: Iff true, current STW initiator is delivering
+       thruptions and not GCing. */
+    boolean thruption;
+
 } gc_dispatcher = {
     /* mutexes lazy initialized, other data initially zeroed */
     .mx_gpunmapped = PTHREAD_MUTEX_INITIALIZER,
@@ -260,6 +342,10 @@ set_thread_csp_access(struct thread* p, boolean writable)
    in progress, begin it by unmapping GC page, and record current
    thread as STW initiator.
 
+   `thruption' flag affects some subtleties of stop/start methods:
+   waiting for other threads allowing GC; setting and clearing
+   STOP_FOR_GC_PENDING, GC_PENDING, THRUPTION_PENDING, etc.
+
    Return true if current thread becomes a GC initiator, or already
    _is_ a STW initiator.
 
@@ -269,7 +355,7 @@ set_thread_csp_access(struct thread* p, boolean writable)
    the right' to stop the world as early as it wants. */
 
 static inline boolean
-maybe_become_stw_initiator()
+maybe_become_stw_initiator(boolean thruption)
 {
     struct thread* self = arch_os_get_current_thread();
 
@@ -284,6 +370,7 @@ maybe_become_stw_initiator()
             odxprint(misc,"NULL STW IN GPTRANSITION, REPLACING");
             /* Then we are... */
             gc_dispatcher.th_stw_initiator = self;
+            gc_dispatcher.thruption = thruption;
 
             /* hold mx_gcing until we restart the world */
             pthread_mutex_lock(&gc_dispatcher.mx_gcing);
@@ -340,22 +427,29 @@ void
 gc_stop_the_world()
 {
     struct thread* self = arch_os_get_current_thread(), *p;
+    boolean thruption;
     if (SymbolTlValue(GC_INHIBIT,self)!=T) {
         /* If GC is enabled, this thread may wait for current STW
            initiator without causing deadlock. */
-        if (!maybe_become_stw_initiator()) {
+        if (!maybe_become_stw_initiator(0)) {
             pthread_mutex_lock(&gc_dispatcher.mx_gcing);
-            maybe_become_stw_initiator();
+            maybe_become_stw_initiator(0);
             pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
         }
         /* Now _this thread_ should be STW initiator */
         gc_assert(self == gc_dispatcher.th_stw_initiator);
     } else {
         /* GC inhibited; e.g. we are inside SUB-GC */
-        if (!maybe_become_stw_initiator()) {
+        if (!maybe_become_stw_initiator(0)) {
             /* Some trouble. Inside SUB-GC, holding the Lisp-side
                mutex, but some other thread is stopping the world. */
-            {
+            if (gc_dispatcher.thruption) {
+                /* Thruption. Wait until it's delivered */
+                pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+                /* Warning: mx_gcing is held recursively. */
+                gc_assert(maybe_become_stw_initiator(0));
+                pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+            } else {
                 /* In SUB-GC, holding mutex; other thread wants to
                    GC. */
                 if (gc_dispatcher.th_subgc == self) {
@@ -382,6 +476,7 @@ gc_stop_the_world()
             }
         }
     }
+    thruption = gc_dispatcher.thruption; /* Thruption or GC? */
     if (!gc_dispatcher.stopped++) {
         /* Outermost stop: signal other threads */
         pthread_mutex_lock(&all_threads_lock);
@@ -411,7 +506,7 @@ gc_stop_the_world()
                 pthread_mutex_unlock(p_qrl);
             } else {
                 /* In C; we just disabled writing. */
-                {
+                if (!thruption) {
                     if (SymbolTlValue(GC_INHIBIT,p)==T) {
                         /* GC inhibited there */
                         SetTlSymbolValue(STOP_FOR_GC_PENDING,T,p);
@@ -436,7 +531,7 @@ gc_stop_the_world()
         odxprint(safepoints,"after remapping GC page %p",self);
 
         SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,self);
-        {
+        if (!thruption) {
             struct thread* priority_gc = NULL;
             for_each_thread(p) {
                 if (p==self)
@@ -499,6 +594,7 @@ void
 gc_start_the_world()
 {
     struct thread* self = arch_os_get_current_thread(), *p;
+    boolean thruption = gc_dispatcher.thruption;
     if (gc_dispatcher.th_stw_initiator != self) {
         odxprint(misc,"Unmapper %p self %p",gc_dispatcher.th_stw_initiator,self);
         gc_assert (gc_dispatcher.th_subgc == self);
@@ -515,11 +611,18 @@ gc_start_the_world()
 
     if (!--gc_dispatcher.stopped) {
         for_each_thread(p) {
-            {
+            if (!thruption) {
                 SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,p);
                 SetTlSymbolValue(GC_PENDING,NIL,p);
             }
-            set_thread_csp_access(p,1);
+            if (
+#ifdef LISP_FEATURE_SB_THRUPTION
+                SymbolTlValue(THRUPTION_PENDING,p)!=T
+#else
+                1 /* trivially no thruption pending */
+#endif
+                || SymbolTlValue(INTERRUPTS_ENABLED,p)!=T)
+                set_thread_csp_access(p,1);
         }
         pthread_mutex_unlock(&all_threads_lock);
         /* Release everyone */
@@ -558,6 +661,17 @@ static void
 set_csp_from_context(struct thread *self, os_context_t *ctx)
 {
     void **sp = (void **) *os_context_register_addr(ctx, reg_SP);
+    /* On POSIX platforms, it is sufficient to investigate only the part
+     * of the stack that was live before the interrupt, because in
+     * addition, we consider interrupt contexts explicitly.  On Windows,
+     * however, we do not keep an explicit stack of exception contexts,
+     * and instead arrange for the conservative stack scan to also cover
+     * the context implicitly.  The obvious way to do that is to start
+     * at the context itself: */
+#ifdef LISP_FEATURE_WIN32
+    gc_assert((void **) ctx < sp);
+    sp = (void**) ctx;
+#endif
     gc_assert((void **)self->control_stack_start
               <= sp && sp
               < (void **)self->control_stack_end);
@@ -590,7 +704,7 @@ thread_pitstop(os_context_t *ctxptr)
             return;
         }
         if ((SymbolTlValue(GC_PENDING,self)!=NIL) &&
-            maybe_become_stw_initiator() && !in_race_p()) {
+            maybe_become_stw_initiator(0) && !in_race_p()) {
             gc_stop_the_world();
             set_thread_csp_access(self,1);
             check_pending_gc(ctxptr);
@@ -613,11 +727,18 @@ thread_pitstop(os_context_t *ctxptr)
                 set_thread_csp_access(self,1);
                 WITH_GC_AT_SAFEPOINTS_ONLY() {
                     pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+#ifdef LISP_FEATURE_SB_THRUPTION
+                    while (check_pending_thruptions(ctxptr))
+                        ;
+#endif
                 }
                 return;
             }
         }
     }
+#ifdef LISP_FEATURE_SB_THRUPTION
+    while(check_pending_thruptions(ctxptr));
+#endif
 }
 
 static inline void
@@ -630,6 +751,18 @@ thread_edge(os_context_t *ctxptr)
             return;             /* trivialize */
         odxprint(safepoints,"edge leaving [%p]", ctxptr);
         if (SymbolTlValue(GC_INHIBIT,self)!=T) {
+#ifdef LISP_FEATURE_SB_THRUPTION
+            if (SymbolTlValue(THRUPTION_PENDING,self)==T &&
+                SymbolTlValue(INTERRUPTS_ENABLED,self)==T) {
+                pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+                set_thread_csp_access(self,1);
+                WITH_GC_AT_SAFEPOINTS_ONLY() {
+                    pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+                    while (check_pending_thruptions(ctxptr))
+                        ;
+                }
+            } else
+#endif
             {
                 pthread_mutex_lock(&gc_dispatcher.mx_gcing);
                 odxprint(safepoints,"edge leaving [%p] took gcing", ctxptr);
@@ -640,6 +773,10 @@ thread_edge(os_context_t *ctxptr)
     } else {
         /* Entering. */
         odxprint(safepoints,"edge entering [%p]", ctxptr);
+#ifdef LISP_FEATURE_SB_THRUPTION
+        while(check_pending_thruptions(ctxptr))
+            ;
+#endif
         if (os_get_csp(self))
             lose("thread_edge: would lose csp");
         set_csp_from_context(self, ctxptr);
@@ -679,11 +816,116 @@ thread_register_gc_trigger()
     gc_assert(SymbolTlValue(GC_INHIBIT,self)!=T);
 
     /* unmap GC page, signal other threads... */
-    maybe_become_stw_initiator();
+    maybe_become_stw_initiator(0);
 }
 
 
 \f
+#ifdef LISP_FEATURE_SB_THRUPTION
+/* wake_thread(thread) -- ensure a thruption delivery to
+ * `thread'. */
+
+# ifdef LISP_FEATURE_WIN32
+
+void
+wake_thread_io(struct thread * thread)
+{
+    SetEvent(thread->private_events.events[1]);
+}
+
+void
+wake_thread_win32(struct thread *thread)
+{
+    wake_thread_io(thread);
+
+    if (SymbolTlValue(THRUPTION_PENDING,thread)==T)
+        return;
+
+    SetTlSymbolValue(THRUPTION_PENDING,T,thread);
+
+    if ((SymbolTlValue(GC_PENDING,thread)==T)||
+        (SymbolTlValue(STOP_FOR_GC_PENDING,thread)==T))
+        return;
+
+    pthread_mutex_unlock(&all_threads_lock);
+
+    if (maybe_become_stw_initiator(1) && !in_race_p()) {
+        gc_stop_the_world();
+        gc_start_the_world();
+    }
+    pthread_mutex_lock(&all_threads_lock);
+    return;
+}
+# else
+int
+wake_thread_posix(os_thread_t os_thread)
+{
+    int found = 0;
+    struct thread *thread;
+    struct thread *self = arch_os_get_current_thread();
+
+    /* Must not and need not attempt to signal ourselves while we're the
+     * STW initiator. */
+    if (self->os_thread == os_thread) {
+        SetTlSymbolValue(THRUPTION_PENDING,T,self);
+        WITH_GC_AT_SAFEPOINTS_ONLY()
+            while (check_pending_thruptions(0 /* ignore the sigmask */))
+                ;
+        return 0;
+    }
+
+    /* We are not in a signal handler here, so need to block signals
+     * manually. */
+    sigset_t oldset;
+    block_deferrable_signals(0, &oldset);
+
+    if (!maybe_become_stw_initiator(1) || in_race_p()) {
+        /* we are not able to wake the thread up, but the STW initiator
+         * will take care of it (kludge: unless it is in foreign code).
+         * Let's at least try to get our return value right. */
+        pthread_mutex_lock(&all_threads_lock);
+        for_each_thread (thread)
+            if (thread->os_thread == os_thread) {
+                found = 1;
+                break;
+            }
+        pthread_mutex_unlock(&all_threads_lock);
+        goto cleanup;
+    }
+    gc_stop_the_world();
+
+    /* we hold the all_threads lock */
+    for_each_thread (thread)
+        if (thread->os_thread == os_thread) {
+            /* it's still alive... */
+            found = 1;
+
+            SetTlSymbolValue(THRUPTION_PENDING,T,thread);
+            if (SymbolTlValue(GC_PENDING,thread) == T
+                || SymbolTlValue(STOP_FOR_GC_PENDING,thread) == T)
+                break;
+
+            if (os_get_csp(thread)) {
+                /* ... and in foreign code.  Push it into a safety
+                 * transition. */
+                int status = pthread_kill(os_thread, SIGPIPE);
+                if (status)
+                    lose("wake_thread_posix: pthread_kill failed with %d\n",
+                         status);
+            }
+            break;
+        }
+
+    /* If it was alive but in Lisp, the pit stop takes care of thruptions. */
+    gc_start_the_world();
+
+cleanup:
+    pthread_sigmask(SIG_SETMASK, &oldset, 0);
+    return found ? 0 : -1;
+}
+#endif /* !LISP_FEATURE_WIN32 */
+#endif /* LISP_FEATURE_SB_THRUPTION */
+
 void
 thread_in_safety_transition(os_context_t *ctx)
 {
@@ -698,6 +940,13 @@ thread_in_lisp_raised(os_context_t *ctx)
     thread_pitstop(ctx);
 }
 
+void
+thread_interrupted(os_context_t *ctx)
+{
+    FSHOW_SIGNAL((stderr, "thread_interrupted\n"));
+    thread_pitstop(ctx);
+}
+
 void**
 os_get_csp(struct thread* th)
 {
@@ -713,6 +962,24 @@ os_get_csp(struct thread* th)
 
 #ifndef LISP_FEATURE_WIN32
 
+# ifdef LISP_FEATURE_SB_THRUPTION
+void
+thruption_handler(int signal, siginfo_t *info, os_context_t *ctx)
+{
+    struct thread *self = arch_os_get_current_thread();
+
+    if (!os_get_csp(self))
+        /* In Lisp code.  Do not run thruptions asynchronously.  The
+         * next safepoint will take care of it. */
+        return;
+
+    /* In C code.  As a rule, we assume that running thruptions is OK. */
+    fake_foreign_function_call(ctx);
+    thread_in_safety_transition(ctx);
+    undo_fake_foreign_function_call(ctx);
+}
+# endif
+
 /* Designed to be of the same type as call_into_lisp.  Ignores its
  * arguments. */
 lispobj