Fix #3429: a tricky race condition

There were two bugs, and had it not been for the first one we would
not have noticed the second one, so this is quite fortunate.

The first bug is in stg_unblockAsyncExceptionszh_ret, when we found a
pending exception to raise, but don't end up raising it, there was a
missing adjustment to the stack pointer.  

The second bug was that this case was actually happening at all: it
ought to be incredibly rare, because the pending exception thread
would have to be killed between us finding it and attempting to raise
the exception.  This made me suspicious.  It turned out that there was
a race condition on the tso->flags field; multiple threads were
updating this bitmask field non-atomically (one of the bits is the
dirty-bit for the generational GC).  The fix is to move the dirty bit
into its own field of the TSO, making the TSO one word larger (sadly).

6 files changed, 24 insertions, 13 deletions

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 16b5d92b30..cd3f2bc4b8 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -49,6 +49,8 @@ import ghczmprim_GHCziBool_True_closure;
 
    -------------------------------------------------------------------------- */
 
+STRING(stg_unblockAsync_err_str, "unblockAsyncExceptions#_ret")
+
 INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
 {
     CInt r;
@@ -81,6 +83,14 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
                 jump %ENTRY_CODE(Sp(0));
             }
         }
+        else {
+            /*
+               the thread might have been removed from the
+               blocked_exception list by someone else in the meantime.
+               Just restore the stack pointer and continue.  
+            */   
+            Sp_adj(2);
+        }
     }
 
     Sp_adj(1);
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index bc2d07a2dc..baadca402c 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1173,7 +1173,7 @@ stg_takeMVarzh
       tso = StgMVar_head(mvar);
       PerformPut(tso,StgMVar_value(mvar));
 
-      if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+      if (TO_W_(StgTSO_dirty(tso)) == 0) {
           foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
       }
 
@@ -1249,7 +1249,7 @@ stg_tryTakeMVarzh
 	/* actually perform the putMVar for the thread that we just woke up */
 	tso = StgMVar_head(mvar);
 	PerformPut(tso,StgMVar_value(mvar));
-        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+        if (TO_W_(StgTSO_dirty(tso)) == 0) {
             foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
         }
 
@@ -1329,7 +1329,7 @@ stg_putMVarzh
 	/* actually perform the takeMVar */
 	tso = StgMVar_head(mvar);
 	PerformTake(tso, val);
-        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+        if (TO_W_(StgTSO_dirty(tso)) == 0) {
             foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
         }
       
@@ -1398,7 +1398,7 @@ stg_tryPutMVarzh
 	/* actually perform the takeMVar */
 	tso = StgMVar_head(mvar);
 	PerformTake(tso, R2);
-        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+        if (TO_W_(StgTSO_dirty(tso)) == 0) {
             foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
         }
       
diff --git a/rts/Sanity.c b/rts/Sanity.c
index 49bbff72c2..4430c4b6bd 100644
--- a/rts/Sanity.c
+++ b/rts/Sanity.c
@@ -581,7 +581,7 @@ checkGlobalTSOList (rtsBool checkTSOs)
           // If this TSO is dirty and in an old generation, it better
           // be on the mutable list.
           if (tso->what_next == ThreadRelocated) continue;
-          if (tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) {
+          if (tso->dirty || (tso->flags & TSO_LINK_DIRTY)) {
               ASSERT(Bdescr((P_)tso)->gen_no == 0 || (tso->flags & TSO_MARKED));
               tso->flags &= ~TSO_MARKED;
           }
diff --git a/rts/Threads.c b/rts/Threads.c
index 28820c8d44..8318e28ca9 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -75,7 +75,8 @@ createThread(Capability *cap, nat size)
 
     tso->why_blocked  = NotBlocked;
     tso->blocked_exceptions = END_TSO_QUEUE;
-    tso->flags = TSO_DIRTY;
+    tso->flags = 0;
+    tso->dirty = 1;
     
     tso->saved_errno = 0;
     tso->bound = NULL;
@@ -377,7 +378,7 @@ printThreadStatus(StgTSO *t)
 	default:
 	    printThreadBlockage(t);
 	}
-        if (t->flags & TSO_DIRTY) {
+        if (t->dirty) {
             debugBelch(" (TSO_DIRTY)");
         } else if (t->flags & TSO_LINK_DIRTY) {
             debugBelch(" (TSO_LINK_DIRTY)");
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 52de561ff8..672636bae1 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -89,10 +89,10 @@ scavengeTSO (StgTSO *tso)
     scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
 
     if (gct->failed_to_evac) {
-        tso->flags |= TSO_DIRTY;
+        tso->dirty = 1;
         scavenge_TSO_link(tso);
     } else {
-        tso->flags &= ~TSO_DIRTY;
+        tso->dirty = 0;
         scavenge_TSO_link(tso);
         if (gct->failed_to_evac) {
             tso->flags |= TSO_LINK_DIRTY;
@@ -1454,7 +1454,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen)
 		continue;
 	    case TSO: {
 		StgTSO *tso = (StgTSO *)p;
-		if ((tso->flags & TSO_DIRTY) == 0) {
+		if (tso->dirty == 0) {
                     // Must be on the mutable list because its link
                     // field is dirty.
                     ASSERT(tso->flags & TSO_LINK_DIRTY);
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 97615e9d1b..59a41b0502 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -850,7 +850,7 @@ void
 setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
 {
     bdescr *bd;
-    if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) {
+    if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
         tso->flags |= TSO_LINK_DIRTY;
 	bd = Bdescr((StgPtr)tso);
 	if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
@@ -862,11 +862,11 @@ void
 dirty_TSO (Capability *cap, StgTSO *tso)
 {
     bdescr *bd;
-    if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) {
+    if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
 	bd = Bdescr((StgPtr)tso);
 	if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
     }
-    tso->flags |= TSO_DIRTY;
+    tso->dirty = 1;
 }
 
 /*