Eagerly raise a blocked exception when entering 'unblock' or exiting 'block'

This fixes #1047

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index ae123f9..62d544c 100644 (file)
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -53,15 +53,37 @@
 INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
                0/*framesize*/, 0/*bitmap*/, RET_SMALL )
 {
+    CInt r;
+
     // Not true: see comments above
     // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
 
-    foreign "C" awakenBlockedExceptionQueue(MyCapability() "ptr", 
-                                           CurrentTSO "ptr") [R1];
-
     StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
        ~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
 
+    /* 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.
+         */
+        SAVE_THREAD_STATE();
+        r = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
+                                                     CurrentTSO "ptr") [R1];
+
+        if (r != 0::CInt) {
+            if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
+                R1 = ThreadFinished;
+                jump StgReturn;
+            } else {
+                LOAD_THREAD_STATE();
+                ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
+                jump %ENTRY_CODE(Sp(0));
+            }
+        }
+    }
+
 #ifdef REG_R1
     Sp_adj(1);
     jump %ENTRY_CODE(Sp(0));
@@ -116,16 +138,39 @@ blockAsyncExceptionszh_fast
 
 unblockAsyncExceptionszh_fast
 {
+    CInt r;
+
     /* Args: R1 :: IO a */
     STK_CHK_GEN( WDS(2), R1_PTR, unblockAsyncExceptionszh_fast);
 
     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) {
-       foreign "C" awakenBlockedExceptionQueue(MyCapability() "ptr", 
-                                               CurrentTSO "ptr") [R1];
 
        StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
           ~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
 
+        /* 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.
+             */
+            SAVE_THREAD_STATE();
+            r = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
+                                                     CurrentTSO "ptr") [R1];
+
+            if (r != 0::CInt) {
+                if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
+                   R1 = ThreadFinished;
+                   jump StgReturn;
+               } else {
+                   LOAD_THREAD_STATE();
+                   ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
+                   jump %ENTRY_CODE(Sp(0));
+               }
+            }
+        }
+
        /* avoid growing the stack unnecessarily */
        if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
            Sp_adj(1);

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index d555953..d892e95 100644 (file)
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -496,9 +496,11 @@ throwToReleaseTarget (void *tso)
    queue, but not perform any throwTo() immediately.  This might be
    more appropriate when the target thread is the one actually running
    (see Exception.cmm).
+
+   Returns: non-zero if an exception was raised, zero otherwise.
    -------------------------------------------------------------------------- */
 
-void
+int
 maybePerformBlockedException (Capability *cap, StgTSO *tso)
 {
     StgTSO *source;
@@ -514,7 +516,7 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
        // locked it.
        if (tso->blocked_exceptions == END_TSO_QUEUE) {
            unlockTSO(tso);
-           return;
+           return 0;
        }
 
        // We unblock just the first thread on the queue, and perform
@@ -524,7 +526,9 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
        tso->blocked_exceptions = unblockOne_(cap, source, 
                                              rtsFalse/*no migrate*/);
        unlockTSO(tso);
+        return 1;
     }
+    return 0;
 }
 
 void

diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h
index 3ab96ab..8052814 100644 (file)
--- a/rts/RaiseAsync.h
+++ b/rts/RaiseAsync.h
@@ -38,7 +38,7 @@ nat throwTo (Capability *cap,          // the Capability we hold
 void throwToReleaseTarget (void *tso);
 #endif
 
-void maybePerformBlockedException (Capability *cap, StgTSO *tso);
+int  maybePerformBlockedException (Capability *cap, StgTSO *tso);
 void awakenBlockedExceptionQueue  (Capability *cap, StgTSO *tso);
 
 /* Determine whether a thread is interruptible (ie. blocked