Fix #3279, #3288: fix crash encountered when calling unblock inside unsafePerformIO

See comments for details

1 files changed, 35 insertions, 8 deletions

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index cf24ef5b49..f0eae988fe 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -124,20 +124,43 @@ unblockAsyncExceptionszh_fast
     CInt r;
 
     /* Args: R1 :: IO a */
-    STK_CHK_GEN( WDS(2), R1_PTR, unblockAsyncExceptionszh_fast);
+    STK_CHK_GEN( WDS(4), R1_PTR, unblockAsyncExceptionszh_fast);
+    /* 4 words: one for the unblock frame, 3 for setting up the
+     * stack to call maybePerformBlockedException() below.
+     */
 
+    /* If exceptions are already unblocked, there's nothing to do */
     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) {
 
 	StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
 	   ~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
 
+	/* avoid growing the stack unnecessarily */
+	if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
+	    Sp_adj(1);
+	} else {
+	    Sp_adj(-1);
+	    Sp(0) = stg_blockAsyncExceptionszh_ret_info;
+	}
+
         /* Eagerly raise a blocked exception, if there is one */
         if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
             /* 
              * We have to be very careful here, as in killThread#, since
              * we are about to raise an async exception in the current
              * thread, which might result in the thread being killed.
+             *
+             * Now, if we are to raise an exception in the current
+             * thread, there might be an update frame above us on the
+             * stack due to unsafePerformIO.  Hence, the stack must
+             * make sense, because it is about to be snapshotted into
+             * an AP_STACK.
              */
+            Sp_adj(-3);
+            Sp(2) = stg_ap_v_info;
+            Sp(1) = R1;
+            Sp(0) = stg_enter_info;
+
             SAVE_THREAD_STATE();
             (r) = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
 						      CurrentTSO "ptr") [R1];
@@ -150,16 +173,12 @@ unblockAsyncExceptionszh_fast
 	            ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
 	            jump %ENTRY_CODE(Sp(0));
 	        }
+            } else {
+                /* we'll just call R1 directly, below */
+                Sp_adj(3);
             }
         }
 
-	/* avoid growing the stack unnecessarily */
-	if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
-	    Sp_adj(1);
-	} else {
-	    Sp_adj(-1);
-	    Sp(0) = stg_blockAsyncExceptionszh_ret_info;
-	}
     }
     TICK_UNKNOWN_CALL();
     TICK_SLOW_CALL_v();
@@ -202,6 +221,14 @@ killThreadzh_fast
         goto loop;
     }
     if (target == CurrentTSO) {
+        /*
+         * So what should happen if a thread calls "throwTo self" inside
+         * unsafePerformIO, and later the closure is evaluated by another
+         * thread?  Presumably it should behave as if throwTo just returned,
+         * and then continue from there.  See #3279, #3288.  This is what
+         * happens: on resumption, we will just jump to the next frame on
+         * the stack, which is the return point for killThreadzh_fast.
+         */
 	SAVE_THREAD_STATE();
 	/* ToDo: what if the current thread is blocking exceptions? */
 	foreign "C" throwToSingleThreaded(MyCapability() "ptr",