Fix a couple of bugs in the throwTo handling, exposed by conc016(threaded2)

2 files changed, 17 insertions, 10 deletions

diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index a528a3f22e..ba672bf805 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -631,8 +631,12 @@ INFO_TABLE_RET( stg_block_throwto, RET_SMALL, P_ unused, P_ unused )
 
 stg_block_throwto_finally
 {
-    // unlock the throwto message
-    unlockClosure(StgTSO_block_info(CurrentTSO), stg_MSG_THROWTO_info);
+    // unlock the throwto message, but only if it wasn't already
+    // unlocked.  It may have been unlocked if we revoked the message
+    // due to an exception being raised during threadPaused().
+    if (StgHeader_info(StgTSO_block_info(CurrentTSO)) == stg_WHITEHOLE_info) {
+        unlockClosure(StgTSO_block_info(CurrentTSO), stg_MSG_THROWTO_info);
+    }
     jump StgReturn;
 }
 
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index d54f823d6e..d02a2567ff 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -70,6 +70,9 @@ throwToSingleThreaded_(Capability *cap, StgTSO *tso, StgClosure *exception,
     if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
 	return;
     }
+    while (tso->what_next == ThreadRelocated) {
+	tso = tso->_link;
+    }
 
     // Remove it from any blocking queues
     removeFromQueues(cap,tso);
@@ -84,6 +87,9 @@ suspendComputation(Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
     if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
 	return;
     }
+    while (tso->what_next == ThreadRelocated) {
+	tso = tso->_link;
+    }
 
     // Remove it from any blocking queues
     removeFromQueues(cap,tso);
@@ -772,20 +778,17 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
         fprintCCS_stderr(tso->prof.CCCS);
     }
 #endif
-
-    while (tso->what_next == ThreadRelocated) {
-        tso = tso->_link;
-    }
+    // ASSUMES: the thread is not already complete or dead, or
+    // ThreadRelocated.  Upper layers should deal with that.
+    ASSERT(tso->what_next != ThreadComplete && 
+           tso->what_next != ThreadKilled && 
+           tso->what_next != ThreadRelocated);
 
     // mark it dirty; we're about to change its stack.
     dirty_TSO(cap, tso);
 
     sp = tso->sp;
     
-    // ASSUMES: the thread is not already complete or dead.  Upper
-    // layers should deal with that.
-    ASSERT(tso->what_next != ThreadComplete && tso->what_next != ThreadKilled);
-
     if (stop_here != NULL) {
         updatee = stop_here->updatee;
     } else {