If exceptions are blocked, add stack overflow to blocked exceptions list. Fixes #8303.

Signed-off-by: Edward Z. Yang <ezyang@mit.edu>

3 files changed, 56 insertions, 18 deletions

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index edc4a91193..86a16d3e08 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -33,9 +33,6 @@ static void removeFromQueues(Capability *cap, StgTSO *tso);
 
 static void removeFromMVarBlockedQueue (StgTSO *tso);
 
-static void blockedThrowTo (Capability *cap, 
-                            StgTSO *target, MessageThrowTo *msg);
-
 static void throwToSendMsg (Capability *cap USED_IF_THREADS,
                             Capability *target_cap USED_IF_THREADS, 
                             MessageThrowTo *msg USED_IF_THREADS);
@@ -467,7 +464,7 @@ throwToSendMsg (Capability *cap STG_UNUSED,
 // Block a throwTo message on the target TSO's blocked_exceptions
 // queue.  The current Capability must own the target TSO in order to
 // modify the blocked_exceptions queue.
-static void
+void
 blockedThrowTo (Capability *cap, StgTSO *target, MessageThrowTo *msg)
 {
     debugTraceCap(DEBUG_sched, cap, "throwTo: blocking on thread %lu",
diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h
index d804f6bc64..1f61b8c72d 100644
--- a/rts/RaiseAsync.h
+++ b/rts/RaiseAsync.h
@@ -16,6 +16,9 @@
 
 #include "BeginPrivate.h"
 
+void blockedThrowTo (Capability *cap, 
+                     StgTSO *target, MessageThrowTo *msg);
+
 void throwToSingleThreaded (Capability *cap,
 			    StgTSO *tso,
 			    StgClosure *exception);
diff --git a/rts/Threads.c b/rts/Threads.c
index 0971288505..1c4500084c 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -499,18 +499,7 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
 
     IF_DEBUG(sanity,checkTSO(tso));
 
-    if (tso->tot_stack_size >= RtsFlags.GcFlags.maxStkSize
-        && !(tso->flags & TSO_BLOCKEX)) {
-        // NB. never raise a StackOverflow exception if the thread is
-        // inside Control.Exception.mask.  It is impractical to protect
-        // against stack overflow exceptions, since virtually anything
-        // can raise one (even 'catch'), so this is the only sensible
-        // thing to do here.  See bug #767.
-        //
-
-        if (tso->flags & TSO_SQUEEZED) {
-            return;
-        }
+    if (tso->tot_stack_size >= RtsFlags.GcFlags.maxStkSize) {
         // #3677: In a stack overflow situation, stack squeezing may
         // reduce the stack size, but we don't know whether it has been
         // reduced enough for the stack check to succeed if we try
@@ -520,6 +509,9 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
         // happened, then we try running the thread again.  The
         // TSO_SQUEEZED flag is set by threadPaused() to tell us whether
         // squeezing happened or not.
+        if (tso->flags & TSO_SQUEEZED) {
+            return;
+        }
 
         debugTrace(DEBUG_gc,
                    "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)",
@@ -531,8 +523,20 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
                                  stg_min(tso->stackobj->stack + tso->stackobj->stack_size,
                                          tso->stackobj->sp+64)));
 
-        // Send this thread the StackOverflow exception
-        throwToSingleThreaded(cap, tso, (StgClosure *)stackOverflow_closure);
+        if (tso->flags & TSO_BLOCKEX) {
+            // NB. StackOverflow exceptions must be deferred if the thread is
+            // inside Control.Exception.mask.  See bug #767 and bug #8303.
+            // This implementation is a minor hack, see Note [Throw to self when masked]
+            MessageThrowTo *msg = (MessageThrowTo*)allocate(cap, sizeofW(MessageThrowTo));
+            SET_HDR(msg, &stg_MSG_THROWTO_info, CCS_SYSTEM);
+            msg->source = tso;
+            msg->target = tso;
+            msg->exception = (StgClosure *)stackOverflow_closure;
+            blockedThrowTo(cap, tso, msg);
+        } else {
+            // Send this thread the StackOverflow exception
+            throwToSingleThreaded(cap, tso, (StgClosure *)stackOverflow_closure);
+        }
     }
 
 
@@ -663,6 +667,40 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
     // IF_DEBUG(scheduler,printTSO(new_tso));
 }
 
+/* Note [Throw to self when masked]
+ *
+ * When a StackOverflow occurs when the thread is masked, we want to
+ * defer the exception to when the thread becomes unmasked/hits an
+ * interruptible point.  We already have a mechanism for doing this,
+ * the blocked_exceptions list, but the use here is a bit unusual,
+ * because an exception is normally only added to this list upon
+ * an asynchronous 'throwTo' call (with all of the relevant
+ * multithreaded nonsense). Morally, a stack overflow should be an
+ * asynchronous exception sent by a thread to itself, and it should
+ * have the same semantics.  But there are a few key differences:
+ *
+ * - If you actually tried to send an asynchronous exception to
+ *   yourself using throwTo, the exception would actually immediately
+ *   be delivered.  This is because throwTo itself is considered an
+ *   interruptible point, so the exception is always deliverable. Thus,
+ *   ordinarily, we never end up with a message to onesself in the
+ *   blocked_exceptions queue.
+ *
+ * - In the case of a StackOverflow, we don't actually care about the
+ *   wakeup semantics; when an exception is delivered, the thread that
+ *   originally threw the exception should be woken up, since throwTo
+ *   blocks until the exception is successfully thrown.  Fortunately,
+ *   it is harmless to wakeup a thread that doesn't actually need waking
+ *   up, e.g. ourselves.
+ *
+ * - No synchronization is necessary, because we own the TSO and the
+ *   capability.  You can observe this by tracing through the execution
+ *   of throwTo.  We skip synchronizing the message and inter-capability
+ *   communication.
+ *
+ * We think this doesn't break any invariants, but do be careful!
+ */
+
 
 /* ---------------------------------------------------------------------------
    Stack underflow - called from the stg_stack_underflow_info frame