Use safepoints for INTERRUPT-THREAD

  * In INTERRUPT-THREAD, stop threads using safepoints instead of
    signals.

  * Currently not used by default.  Users need to set feature
    SB-THRUPTION to enable this code.  SB-THRUPTION should only be set
    when SB-SAFEPOINT is also enabled.

  * This feature should ultimately be rolled into SB-SAFEPOINT, but
    remains as a separate build option until both versions are equally
    well-tested, and until other avoidable uses of signals have also
    been replaced by safepoints.

  * On the term "thruption": Earlier work on this feature sometimes
    used "interrupt" to refer to INTERRUPT-THREAD, causing confusion
    with the traditional meaning of "interrupt" as POSIX signal or WIN32
    exception.  To avoid such confusion, the runtime now refers to
    INTERRUPT-THREAD as a "thruption", short for th(read) (inter)ruption.

  * SIGPIPE is not used for threads running Lisp code, but a low-level
    handler for SIGPIPE still exists which arranges for threads running
    FFI code (in particular, threads blocked in poll, select,
    futex_wait) to be interrupted.

  * OS support: Minor changes to signal handling required, currently
    implemented for Linux and Solaris.

Credits: This is a POSIX backport of Windows threading changes by
Anton Kovalenko and Dmitry Kalyanov.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index aee1301..1ff195b 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -2338,6 +2338,7 @@ SB-KERNEL) have been undone, but probably more remain."
                "*ALLOW-WITH-INTERRUPTS*"
                "*INTERRUPTS-ENABLED*"
                "*INTERRUPT-PENDING*"
                "*ALLOW-WITH-INTERRUPTS*"
                "*INTERRUPTS-ENABLED*"
                "*INTERRUPT-PENDING*"

+               #!+sb-thruption "*THRUPTION-PENDING*"

                "*LINKAGE-INFO*"
                "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*"
                "*PERIODIC-POLLING-FUNCTION*"
                "*LINKAGE-INFO*"
                "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*"
                "*PERIODIC-POLLING-FUNCTION*"

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 30f3eaa..c343f4a 100644 (file)
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -101,6 +101,7 @@
         sb!unix::*unblock-deferrables-on-enabling-interrupts-p* nil
         *interrupts-enabled* t
         *interrupt-pending* nil
         sb!unix::*unblock-deferrables-on-enabling-interrupts-p* nil
         *interrupts-enabled* t
         *interrupt-pending* nil

+        #!+sb-thruption #!+sb-thruption *thruption-pending* nil

         *break-on-signals* nil
         *maximum-error-depth* 10
         *current-error-depth* 0
         *break-on-signals* nil
         *maximum-error-depth* 10
         *current-error-depth* 0

diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp
index 7f0ff41..6de6698 100644 (file)
--- a/src/code/early-impl.lisp
+++ b/src/code/early-impl.lisp
@@ -42,6 +42,7 @@
                   sb!unix::*unblock-deferrables-on-enabling-interrupts-p*
                   *interrupts-enabled*
                   *interrupt-pending*
                   sb!unix::*unblock-deferrables-on-enabling-interrupts-p*
                   *interrupts-enabled*
                   *interrupt-pending*

+                  #!+sb-thruption *thruption-pending*

                   #!+sb-safepoint *gc-safe*
                   #!+sb-safepoint *in-safepoint*
                   *free-interrupt-context-index*
                   #!+sb-safepoint *gc-safe*
                   #!+sb-safepoint *in-safepoint*
                   *free-interrupt-context-index*

diff --git a/src/code/signal.lisp b/src/code/signal.lisp
index 9092524..945f77c 100644 (file)
--- a/src/code/signal.lisp
+++ b/src/code/signal.lisp
@@ -50,6 +50,7 @@
 
 (defvar *interrupts-enabled* t)
 (defvar *interrupt-pending* nil)
 
 (defvar *interrupts-enabled* t)
 (defvar *interrupt-pending* nil)

+#!+sb-thruption (defvar *thruption-pending* nil)

 (defvar *allow-with-interrupts* t)
 ;;; This is to support signal handlers that want to return to the
 ;;; interrupted context without leaving anything extra on the stack. A
 (defvar *allow-with-interrupts* t)
 ;;; This is to support signal handlers that want to return to the
 ;;; interrupted context without leaving anything extra on the stack. A

@@ -122,7 +123,8 @@ WITHOUT-INTERRUPTS in:
                             (setq *unblock-deferrables-on-enabling-interrupts-p*
                                   nil)
                             (sb!unix::unblock-deferrable-signals))
                             (setq *unblock-deferrables-on-enabling-interrupts-p*
                                   nil)
                             (sb!unix::unblock-deferrable-signals))

-                          (when *interrupt-pending*
+                          (when (or *interrupt-pending*
+                                    #!+sb-thruption *thruption-pending*)

                             (receive-pending-interrupt)))
                         (locally ,@with-forms))))
                 (let ((*interrupts-enabled* nil)
                             (receive-pending-interrupt)))
                         (locally ,@with-forms))))
                 (let ((*interrupts-enabled* nil)

@@ -144,7 +146,8 @@ WITHOUT-INTERRUPTS in:
              ;; another WITHOUT-INTERRUPTS, the pending interrupt will be
              ;; handled immediately upon exit from said
              ;; WITHOUT-INTERRUPTS, so it is as if nothing has happened.
              ;; another WITHOUT-INTERRUPTS, the pending interrupt will be
              ;; handled immediately upon exit from said
              ;; WITHOUT-INTERRUPTS, so it is as if nothing has happened.

-             (when *interrupt-pending*
+             (when (or *interrupt-pending*
+                       #!+sb-thruption *thruption-pending*)

                (receive-pending-interrupt)))
            (,without-interrupts-body)))))
 
                (receive-pending-interrupt)))
            (,without-interrupts-body)))))
 

@@ -169,7 +172,8 @@ by ALLOW-WITH-INTERRUPTS."
          (when *unblock-deferrables-on-enabling-interrupts-p*
            (setq *unblock-deferrables-on-enabling-interrupts-p* nil)
            (sb!unix::unblock-deferrable-signals))
          (when *unblock-deferrables-on-enabling-interrupts-p*
            (setq *unblock-deferrables-on-enabling-interrupts-p* nil)
            (sb!unix::unblock-deferrable-signals))

-         (when *interrupt-pending*
+         (when (or *interrupt-pending*
+                   #!+sb-thruption *thruption-pending*)

            (receive-pending-interrupt)))
        (locally ,@body))))
 
            (receive-pending-interrupt)))
        (locally ,@body))))
 

@@ -189,6 +193,6 @@ by ALLOW-WITH-INTERRUPTS."
 (defun %check-interrupts ()
   ;; Here we check for pending interrupts first, because reading a
   ;; special is faster then binding it!
 (defun %check-interrupts ()
   ;; Here we check for pending interrupts first, because reading a
   ;; special is faster then binding it!

-  (when *interrupt-pending*
+  (when (or *interrupt-pending* #!+sb-thruption *thruption-pending*)

     (let ((*interrupts-enabled* t))
       (receive-pending-interrupt))))
     (let ((*interrupts-enabled* t))
       (receive-pending-interrupt))))

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index 4343fb6..e62f87a 100644 (file)
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -200,6 +200,7 @@
   (declare (ignore signal code context))
   (sb!ext:exit))
 
   (declare (ignore signal code context))
   (sb!ext:exit))
 

+#!-sb-thruption

 ;;; SIGPIPE is not used in SBCL for its original purpose, instead it's
 ;;; for signalling a thread that it should look at its interruption
 ;;; queue. The handler (RUN_INTERRUPTION) just returns if there is
 ;;; SIGPIPE is not used in SBCL for its original purpose, instead it's
 ;;; for signalling a thread that it should look at its interruption
 ;;; queue. The handler (RUN_INTERRUPTION) just returns if there is

@@ -227,6 +228,7 @@
   #!-linux
   (enable-interrupt sigsys #'sigsys-handler)
   (enable-interrupt sigalrm #'sigalrm-handler)
   #!-linux
   (enable-interrupt sigsys #'sigsys-handler)
   (enable-interrupt sigalrm #'sigalrm-handler)

+  #!-sb-thruption

   (enable-interrupt sigpipe #'sigpipe-handler)
   (enable-interrupt sigchld #'sigchld-handler)
   #!+hpux (ignore-interrupt sigxcpu)
   (enable-interrupt sigpipe #'sigpipe-handler)
   (enable-interrupt sigchld #'sigchld-handler)
   #!+hpux (ignore-interrupt sigxcpu)

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 3b00593..bd0d0fb 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -342,6 +342,10 @@ See also: RETURN-FROM-THREAD and SB-EXT:EXIT."
   (os-thread #!-alpha unsigned-long #!+alpha unsigned-int)
   (signal int))
 
   (os-thread #!-alpha unsigned-long #!+alpha unsigned-int)
   (signal int))
 

+(define-alien-routine "wake_thread"
+    integer
+  (os-thread #!-alpha unsigned-long #!+alpha unsigned-int))
+

 #!+sb-thread
 (progn
   ;; FIXME it would be good to define what a thread id is or isn't
 #!+sb-thread
 (progn
   ;; FIXME it would be good to define what a thread id is or isn't

@@ -1437,6 +1441,8 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
                                   ;; interupts to be lost: SIGINT comes to
                                   ;; mind.
                                   (setq *interrupt-pending* nil)
                                   ;; interupts to be lost: SIGINT comes to
                                   ;; mind.
                                   (setq *interrupt-pending* nil)

+                                  #!+sb-thruption
+                                  (setq *thruption-pending* nil)

                                   (handle-thread-exit thread)))))))))
                   (values))))
          ;; If the starting thread is stopped for gc before it signals the
                                   (handle-thread-exit thread)))))))))
                   (values))))
          ;; If the starting thread is stopped for gc before it signals the

@@ -1504,7 +1510,7 @@ subject to change."
      ,@body))
 
 ;;; Called from the signal handler.
      ,@body))
 
 ;;; Called from the signal handler.

-#!-win32
+#!-(or sb-thruption win32)

 (defun run-interruption ()
   (let ((interruption (with-interruptions-lock (*current-thread*)
                         (pop (thread-interruptions *current-thread*)))))
 (defun run-interruption ()
   (let ((interruption (with-interruptions-lock (*current-thread*)
                         (pop (thread-interruptions *current-thread*)))))

@@ -1517,6 +1523,16 @@ subject to change."
     (when interruption
       (funcall interruption))))
 
     (when interruption
       (funcall interruption))))
 

+#!+sb-thruption
+(defun run-interruption ()
+  (in-interruption () ;the non-thruption code does this in the signal handler
+    (loop
+       (let ((interruption (with-interruptions-lock (*current-thread*)
+                             (pop (thread-interruptions *current-thread*)))))
+         (unless interruption
+           (return))
+         (funcall interruption)))))
+

 (defun interrupt-thread (thread function)
   #!+sb-doc
   "Interrupt THREAD and make it run FUNCTION.
 (defun interrupt-thread (thread function)
   #!+sb-doc
   "Interrupt THREAD and make it run FUNCTION.

@@ -1591,7 +1607,7 @@ Short version: be careful out there."
                                    (without-interrupts
                                      (allow-with-interrupts
                                        (funcall function))))))))
                                    (without-interrupts
                                      (allow-with-interrupts
                                        (funcall function))))))))

-           (when (minusp (kill-safely os-thread sb!unix:sigpipe))
+           (when (minusp (wake-thread os-thread))

              (error 'interrupt-thread-error :thread thread))))))
 
 (defun terminate-thread (thread)
              (error 'interrupt-thread-error :thread thread))))))
 
 (defun terminate-thread (thread)

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 714fc4a..f3f226b 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -30,6 +30,7 @@
                   *allow-with-interrupts*
                   *interrupts-enabled*
                   *interrupt-pending*
                   *allow-with-interrupts*
                   *interrupts-enabled*
                   *interrupt-pending*

+                  #!+sb-thruption *thruption-pending*

                   *type-system-initialized*))
 
 (defvar *cold-init-complete-p*)
                   *type-system-initialized*))
 
 (defvar *cold-init-complete-p*)

diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp
index f720872..b49671f 100644 (file)
--- a/src/compiler/generic/parms.lisp
+++ b/src/compiler/generic/parms.lisp
@@ -48,7 +48,8 @@
     sb!di::handle-breakpoint
     sb!di::handle-single-step-trap
     fdefinition-object
     sb!di::handle-breakpoint
     sb!di::handle-single-step-trap
     fdefinition-object

-    #!+win32 sb!kernel::handle-win32-exception))
+    #!+win32 sb!kernel::handle-win32-exception
+    #!+sb-thruption sb!thread::run-interruption))

 
 (defparameter *common-static-symbols*
   '(t
 
 (defparameter *common-static-symbols*
   '(t

@@ -80,6 +81,8 @@
     sb!unix::*allow-with-interrupts*
     sb!unix::*interrupts-enabled*
     sb!unix::*interrupt-pending*
     sb!unix::*allow-with-interrupts*
     sb!unix::*interrupts-enabled*
     sb!unix::*interrupt-pending*

+    #!+sb-thruption sb!unix::*thruption-pending*
+    #!+sb-thruption sb!impl::*restart-clusters*

     *in-without-gcing*
     *gc-inhibit*
     *gc-pending*
     *in-without-gcing*
     *gc-inhibit*
     *gc-pending*

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 2a82a2e..a5ca08d 100644 (file)
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -842,9 +842,14 @@ interrupt_handle_pending(os_context_t *context)
      * thus we end up here again. Third, when calling GC-ON or at the
      * end of a WITHOUT-GCING, MAYBE-HANDLE-PENDING-GC will trap to
      * here if there is a pending GC. Fourth, ahem, at the end of
      * thus we end up here again. Third, when calling GC-ON or at the
      * end of a WITHOUT-GCING, MAYBE-HANDLE-PENDING-GC will trap to
      * here if there is a pending GC. Fourth, ahem, at the end of

-     * WITHOUT-INTERRUPTS (bar complications with nesting). */
-
-    /* Win32 only needs to handle the GC cases (for now?) */
+     * WITHOUT-INTERRUPTS (bar complications with nesting).
+     *
+     * A fourth way happens with safepoints: In addition to a stop for
+     * GC that is pending, there are thruptions.  Both mechanisms are
+     * mostly signal-free, yet also of an asynchronous nature, so it makes
+     * sense to let interrupt_handle_pending take care of running them:
+     * It gets run precisely at those places where it is safe to process
+     * pending asynchronous tasks. */

 
     struct thread *thread = arch_os_get_current_thread();
     struct interrupt_data *data = thread->interrupt_data;
 
     struct thread *thread = arch_os_get_current_thread();
     struct interrupt_data *data = thread->interrupt_data;

@@ -890,8 +895,42 @@ interrupt_handle_pending(os_context_t *context)
         void *original_pending_handler = data->pending_handler;
 
 #ifdef LISP_FEATURE_SB_SAFEPOINT
         void *original_pending_handler = data->pending_handler;
 
 #ifdef LISP_FEATURE_SB_SAFEPOINT

-        /* handles the STOP_FOR_GC_PENDING case */
-        thread_pitstop(context);
+        /* handles the STOP_FOR_GC_PENDING case, plus THRUPTIONS */
+        if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL
+# ifdef LISP_FEATURE_SB_THRUPTION
+            || SymbolValue(THRUPTION_PENDING,thread) != NIL
+# endif
+            )
+        {
+            /* We ought to take this chance to do a pitstop now. */
+
+            /* Now, it goes without saying that the context sigmask
+             * tweaking around this call is not pretty.  However, it
+             * currently seems to be "needed" for the following
+             * situation.  (So let's find a better solution and remove
+             * this comment afterwards.)
+             *
+             * Suppose we are in a signal handler (let's say SIGALRM).
+             * At the end of a WITHOUT-INTERRUPTS, the lisp code notices
+             * that a thruption is pending, and says to itself "let's
+             * receive pending interrupts then".  We trust that the
+             * caller is happy to run those sorts of things now,
+             * including thruptions, otherwise it wouldn't have called
+             * us.  But that's the problem: Even though we can guess the
+             * caller's intention, may_thrupt() would see that signals
+             * are blocked in the signal context (because that context
+             * itself points to a signal handler).  So we cheat and
+             * pretend that signals weren't blocked.
+             * --DFL */
+#ifndef LISP_FEATURE_WIN32
+            sigset_t old, *ctxset = os_context_sigmask_addr(context);
+            unblock_signals(&deferrable_sigset, ctxset, &old);
+#endif
+            thread_pitstop(context);
+#ifndef LISP_FEATURE_WIN32
+            sigcopyset(&old, ctxset);
+#endif
+        }

 #elif defined(LISP_FEATURE_SB_THREAD)
         if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) {
             /* STOP_FOR_GC_PENDING and GC_PENDING are cleared by
 #elif defined(LISP_FEATURE_SB_THREAD)
         if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) {
             /* STOP_FOR_GC_PENDING and GC_PENDING are cleared by

@@ -978,6 +1017,17 @@ interrupt_handle_pending(os_context_t *context)
         sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
         run_deferred_handler(data, context);
     }
         sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
         run_deferred_handler(data, context);
     }

+#ifdef LISP_FEATURE_SB_THRUPTION
+    if (SymbolValue(THRUPTION_PENDING,thread)==T)
+        /* Special case for the following situation: There is a
+         * thruption pending, but a signal had been deferred.  The
+         * pitstop at the top of this function could only take care
+         * of GC, and skipped the thruption, so we need to try again
+         * now that INTERRUPT_PENDING and the sigmask have been
+         * reset. */
+        while (check_pending_thruptions(context))
+            ;
+#endif

 #endif
 #ifdef LISP_FEATURE_GENCGC
     if (get_pseudo_atomic_interrupted(thread))
 #endif
 #ifdef LISP_FEATURE_GENCGC
     if (get_pseudo_atomic_interrupted(thread))

@@ -1792,6 +1842,15 @@ undoably_install_low_level_interrupt_handler (int signal,
     else
         sa.sa_sigaction = low_level_handle_now_handler;
 
     else
         sa.sa_sigaction = low_level_handle_now_handler;
 

+#ifdef LISP_FEATURE_SB_THRUPTION
+    /* It's in `deferrable_sigset' so that we block&unblock it properly,
+     * but we don't actually want to defer it.  And if we put it only
+     * into blockable_sigset, we'd have to special-case it around thread
+     * creation at least. */
+    if (signal == SIGPIPE)
+        sa.sa_sigaction = low_level_handle_now_handler;
+#endif
+

     sigcopyset(&sa.sa_mask, &blockable_sigset);
     sa.sa_flags = SA_SIGINFO | SA_RESTART
         | (sigaction_nodefer_works ? SA_NODEFER : 0);
     sigcopyset(&sa.sa_mask, &blockable_sigset);
     sa.sa_flags = SA_SIGINFO | SA_RESTART
         | (sigaction_nodefer_works ? SA_NODEFER : 0);

diff --git a/src/runtime/interrupt.h b/src/runtime/interrupt.h
index a148236..90fad67 100644 (file)
--- a/src/runtime/interrupt.h
+++ b/src/runtime/interrupt.h
@@ -177,6 +177,9 @@ extern void lower_thread_control_stack_guard_page(struct thread *th);
 extern void reset_thread_control_stack_guard_page(struct thread *th);
 
 #if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_WIN32)
 extern void reset_thread_control_stack_guard_page(struct thread *th);
 
 #if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_WIN32)

+# ifdef LISP_FEATURE_SB_THRUPTION
+void thruption_handler(int signal, siginfo_t *info, os_context_t *context);
+# endif

 void rtmin0_handler(int signal, siginfo_t *info, os_context_t *context);
 void rtmin1_handler(int signal, siginfo_t *info, os_context_t *context);
 #endif
 void rtmin0_handler(int signal, siginfo_t *info, os_context_t *context);
 void rtmin1_handler(int signal, siginfo_t *info, os_context_t *context);
 #endif

diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c
index 43cd19f..bc87f2a 100644 (file)
--- a/src/runtime/linux-os.c
+++ b/src/runtime/linux-os.c
@@ -453,8 +453,15 @@ os_install_interrupt_handlers(void)
 {
     undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
                                                  sigsegv_handler);
 {
     undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
                                                  sigsegv_handler);

+
+    /* OAOOM c.f. sunos-os.c.
+     * Should we have a reusable function gc_install_interrupt_handlers? */

 #ifdef LISP_FEATURE_SB_THREAD
 #ifdef LISP_FEATURE_SB_THREAD

-# ifndef LISP_FEATURE_SB_SAFEPOINT
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+#  ifdef LISP_FEATURE_SB_THRUPTION
+    undoably_install_low_level_interrupt_handler(SIGPIPE, thruption_handler);
+#  endif
+# else

     undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
                                                  sig_stop_for_gc_handler);
 # endif
     undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
                                                  sig_stop_for_gc_handler);
 # endif

diff --git a/src/runtime/safepoint.c b/src/runtime/safepoint.c
index 953b8e9..d730657 100644 (file)
--- a/src/runtime/safepoint.c
+++ b/src/runtime/safepoint.c
@@ -101,6 +101,83 @@ thread_may_gc()
                 SymbolTlValue(GC_PENDING, self) == NIL));
 }
 
                 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();
+
+    gc_assert(!os_get_csp(p));
+
+    if (!thread_may_thrupt(ctx))
+        return 0;
+    if (SymbolValue(THRUPTION_PENDING, p) == NIL)
+        return 0;
+    SetSymbolValue(THRUPTION_PENDING, NIL, p);
+
+    sigset_t oldset;
+    block_deferrable_signals(0, &oldset);
+
+    funcall0(StaticSymbolFunction(RUN_INTERRUPTION));
+
+    pthread_sigmask(SIG_SETMASK, &oldset, 0);
+    return 1;
+}
+#endif
+

 int
 on_stack_p(struct thread *th, void *esp)
 {
 int
 on_stack_p(struct thread *th, void *esp)
 {

@@ -219,6 +296,10 @@ struct gc_dispatcher {
        work without thundering herd. */
     int stopped;
 
        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,
 } gc_dispatcher = {
     /* mutexes lazy initialized, other data initially zeroed */
     .mx_gpunmapped = PTHREAD_MUTEX_INITIALIZER,

@@ -260,6 +341,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.
 
    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.
 
    Return true if current thread becomes a GC initiator, or already
    _is_ a STW initiator.
 

@@ -269,7 +354,7 @@ set_thread_csp_access(struct thread* p, boolean writable)
    the right' to stop the world as early as it wants. */
 
 static inline boolean
    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();
 
 {
     struct thread* self = arch_os_get_current_thread();
 

@@ -284,6 +369,7 @@ maybe_become_stw_initiator()
             odxprint(misc,"NULL STW IN GPTRANSITION, REPLACING");
             /* Then we are... */
             gc_dispatcher.th_stw_initiator = self;
             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);
 
             /* hold mx_gcing until we restart the world */
             pthread_mutex_lock(&gc_dispatcher.mx_gcing);

@@ -340,22 +426,29 @@ void
 gc_stop_the_world()
 {
     struct thread* self = arch_os_get_current_thread(), *p;
 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 (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);
             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 */
             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. */
             /* 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) {
                 /* In SUB-GC, holding mutex; other thread wants to
                    GC. */
                 if (gc_dispatcher.th_subgc == self) {

@@ -382,6 +475,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);
     if (!gc_dispatcher.stopped++) {
         /* Outermost stop: signal other threads */
         pthread_mutex_lock(&all_threads_lock);

@@ -411,7 +505,7 @@ gc_stop_the_world()
                 pthread_mutex_unlock(p_qrl);
             } else {
                 /* In C; we just disabled writing. */
                 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);
                     if (SymbolTlValue(GC_INHIBIT,p)==T) {
                         /* GC inhibited there */
                         SetTlSymbolValue(STOP_FOR_GC_PENDING,T,p);

@@ -436,7 +530,7 @@ gc_stop_the_world()
         odxprint(safepoints,"after remapping GC page %p",self);
 
         SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,self);
         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)
             struct thread* priority_gc = NULL;
             for_each_thread(p) {
                 if (p==self)

@@ -499,6 +593,7 @@ void
 gc_start_the_world()
 {
     struct thread* self = arch_os_get_current_thread(), *p;
 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);
     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 +610,18 @@ gc_start_the_world()
 
     if (!--gc_dispatcher.stopped) {
         for_each_thread(p) {
 
     if (!--gc_dispatcher.stopped) {
         for_each_thread(p) {

-            {
+            if (!thruption) {

                 SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,p);
                 SetTlSymbolValue(GC_PENDING,NIL,p);
             }
                 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 */
         }
         pthread_mutex_unlock(&all_threads_lock);
         /* Release everyone */

@@ -590,7 +692,7 @@ thread_pitstop(os_context_t *ctxptr)
             return;
         }
         if ((SymbolTlValue(GC_PENDING,self)!=NIL) &&
             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);
             gc_stop_the_world();
             set_thread_csp_access(self,1);
             check_pending_gc(ctxptr);

@@ -613,11 +715,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);
                 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;
             }
         }
     }
                 }
                 return;
             }
         }
     }

+#ifdef LISP_FEATURE_SB_THRUPTION
+    while(check_pending_thruptions(ctxptr));
+#endif

 }
 
 static inline void
 }
 
 static inline void

@@ -630,6 +739,18 @@ thread_edge(os_context_t *ctxptr)
             return;             /* trivialize */
         odxprint(safepoints,"edge leaving [%p]", ctxptr);
         if (SymbolTlValue(GC_INHIBIT,self)!=T) {
             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);
             {
                 pthread_mutex_lock(&gc_dispatcher.mx_gcing);
                 odxprint(safepoints,"edge leaving [%p] took gcing", ctxptr);

@@ -640,6 +761,10 @@ thread_edge(os_context_t *ctxptr)
     } else {
         /* Entering. */
         odxprint(safepoints,"edge entering [%p]", 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);
         if (os_get_csp(self))
             lose("thread_edge: would lose csp");
         set_csp_from_context(self, ctxptr);

@@ -679,11 +804,83 @@ thread_register_gc_trigger()
     gc_assert(SymbolTlValue(GC_INHIBIT,self)!=T);
 
     /* unmap GC page, signal other threads... */
     gc_assert(SymbolTlValue(GC_INHIBIT,self)!=T);
 
     /* unmap GC page, signal other threads... */

-    maybe_become_stw_initiator();
+    maybe_become_stw_initiator(0);

 }
 
 
 \f
 }
 
 
 \f

+#ifdef LISP_FEATURE_SB_THRUPTION
+/* wake_thread(thread) -- ensure a thruption delivery to
+ * `thread'. */
+
+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_SB_THRUPTION */
+

 void
 thread_in_safety_transition(os_context_t *ctx)
 {
 void
 thread_in_safety_transition(os_context_t *ctx)
 {

@@ -698,6 +895,13 @@ thread_in_lisp_raised(os_context_t *ctx)
     thread_pitstop(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)
 {
 void**
 os_get_csp(struct thread* th)
 {

@@ -713,6 +917,24 @@ os_get_csp(struct thread* th)
 
 #ifndef LISP_FEATURE_WIN32
 
 
 #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
 /* Designed to be of the same type as call_into_lisp.  Ignores its
  * arguments. */
 lispobj

diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c
index 769d0a4..c1925ed 100644 (file)
--- a/src/runtime/sunos-os.c
+++ b/src/runtime/sunos-os.c
@@ -169,8 +169,14 @@ os_install_interrupt_handlers()
     undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
                                                  sigsegv_handler);
 
     undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
                                                  sigsegv_handler);
 

+    /* OAOOM c.f. linux-os.c.
+     * Should we have a reusable function gc_install_interrupt_handlers? */

 #ifdef LISP_FEATURE_SB_THREAD
 #ifdef LISP_FEATURE_SB_THREAD

-# ifndef LISP_FEATURE_SB_SAFEPOINT
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+#  ifdef LISP_FEATURE_SB_THRUPTION
+    undoably_install_low_level_interrupt_handler(SIGPIPE, thruption_handler);
+#  endif
+# else

     undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
                                                  sig_stop_for_gc_handler);
 # endif
     undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
                                                  sig_stop_for_gc_handler);
 # endif

diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index db24c6e..d52c812 100644 (file)
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -598,6 +598,10 @@ create_thread_struct(lispobj initial_function) {
     bind_variable(GC_SAFE,NIL,th);
     bind_variable(IN_SAFEPOINT,NIL,th);
 #endif
     bind_variable(GC_SAFE,NIL,th);
     bind_variable(IN_SAFEPOINT,NIL,th);
 #endif

+#ifdef LISP_FEATURE_SB_THRUPTION
+    bind_variable(THRUPTION_PENDING,NIL,th);
+    bind_variable(RESTART_CLUSTERS,NIL,th);
+#endif

 #ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
     access_control_stack_pointer(th)=th->control_stack_start;
 #endif
 #ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
     access_control_stack_pointer(th)=th->control_stack_start;
 #endif

@@ -816,6 +820,19 @@ thread_yield()
 #endif
 }
 
 #endif
 }
 

+int
+wake_thread(os_thread_t os_thread)
+{
+#ifdef LISP_FEATURE_WIN32
+# define SIGPIPE 1
+#endif
+#if !defined(LISP_FEATURE_SB_THRUPTION) || defined(LISP_FEATURE_WIN32)
+    return kill_safely(os_thread, SIGPIPE);
+#else
+    return wake_thread_posix(os_thread);
+#endif
+}
+

 /* If the thread id given does not belong to a running thread (it has
  * exited or never even existed) pthread_kill _may_ fail with ESRCH,
  * but it is also allowed to just segfault, see
 /* If the thread id given does not belong to a running thread (it has
  * exited or never even existed) pthread_kill _may_ fail with ESRCH,
  * but it is also allowed to just segfault, see

@@ -825,13 +842,13 @@ thread_yield()
  * (NPTL recycles them extremely fast) so a signal can be sent to
  * another process if the one it was sent to exited.
  *
  * (NPTL recycles them extremely fast) so a signal can be sent to
  * another process if the one it was sent to exited.
  *

- * We send signals in two places: signal_interrupt_thread sends a
- * signal that's harmless if delivered to another thread, but
- * SIG_STOP_FOR_GC is fatal.
- *

  * For these reasons, we must make sure that the thread is still alive
  * when the pthread_kill is called and return if the thread is
  * For these reasons, we must make sure that the thread is still alive
  * when the pthread_kill is called and return if the thread is

- * exiting. */
+ * exiting.
+ *
+ * Note (DFL, 2011-06-22): At the time of writing, this function is only
+ * used for INTERRUPT-THREAD, hence the wake_thread special-case for
+ * Windows is OK. */

 int
 kill_safely(os_thread_t os_thread, int signal)
 {
 int
 kill_safely(os_thread_t os_thread, int signal)
 {

diff --git a/src/runtime/thread.h b/src/runtime/thread.h
index c8c15e5..2a8ea6e 100644 (file)
--- a/src/runtime/thread.h
+++ b/src/runtime/thread.h
@@ -350,9 +350,15 @@ extern kern_return_t mach_lisp_thread_destroy(struct thread *thread);
 #ifdef LISP_FEATURE_SB_SAFEPOINT
 void thread_in_safety_transition(os_context_t *ctx);
 void thread_in_lisp_raised(os_context_t *ctx);
 #ifdef LISP_FEATURE_SB_SAFEPOINT
 void thread_in_safety_transition(os_context_t *ctx);
 void thread_in_lisp_raised(os_context_t *ctx);

+void thread_interrupted(os_context_t *ctx);

 void thread_pitstop(os_context_t *ctxptr);
 extern void thread_register_gc_trigger();
 
 void thread_pitstop(os_context_t *ctxptr);
 extern void thread_register_gc_trigger();
 

+# ifdef LISP_FEATURE_SB_THRUPTION
+int wake_thread(os_thread_t os_thread);
+int wake_thread_posix(os_thread_t os_thread);
+# endif
+

 #define thread_qrl(th) (&(th)->nonpointer_data->qrl_lock)
 
 static inline
 #define thread_qrl(th) (&(th)->nonpointer_data->qrl_lock)
 
 static inline

@@ -406,6 +412,8 @@ void pop_gcing_safety(struct gcing_safety *from)
 #define WITH_STATE_SEM(thread)                                     \
     WITH_STATE_SEM_hygenic(sbcl__state_sem, thread)
 
 #define WITH_STATE_SEM(thread)                                     \
     WITH_STATE_SEM_hygenic(sbcl__state_sem, thread)
 

+int check_pending_thruptions(os_context_t *ctx);
+

 #endif
 
 extern boolean is_some_thread_local_addr(os_vm_address_t addr);
 #endif
 
 extern boolean is_some_thread_local_addr(os_vm_address_t addr);

diff --git a/tests/kill-non-lisp-thread.impure.lisp b/tests/kill-non-lisp-thread.impure.lisp
index cecce9e..b700420 100644 (file)
--- a/tests/kill-non-lisp-thread.impure.lisp
+++ b/tests/kill-non-lisp-thread.impure.lisp
@@ -42,6 +42,12 @@
     (push (lambda ()
             (setq receivedp t))
           (sb-thread::thread-interruptions sb-thread:*current-thread*))
     (push (lambda ()
             (setq receivedp t))
           (sb-thread::thread-interruptions sb-thread:*current-thread*))

+    #+sb-thruption
+    ;; On sb-thruption builds, the usual resignalling of SIGPIPE will
+    ;; work without problems, but the signal handler won't ordinarily
+    ;; think that there's anything to be done.  Since we're poking at
+    ;; INTERRUPT-THREAD internals anyway, let's help it along.
+    (setf sb-unix::*thruption-pending* t)

     (kill-non-lisp-thread)
     (sleep 1)
     (assert receivedp)))
     (kill-non-lisp-thread)
     (sleep 1)
     (assert receivedp)))