add STM support to the new throwTo mechanism

2 files changed, 32 insertions, 10 deletions

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 9041c06cb2..b0c7064540 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -401,7 +401,23 @@ check_target:
     }	
 
     case BlockedOnSTM:
-	barf("ToDo");
+	lockTSO(target);
+	// Unblocking BlockedOnSTM threads requires the TSO to be
+	// locked; see STM.c:unpark_tso().
+	if (target->why_blocked != BlockedOnSTM) {
+	    goto retry;
+	}
+	if ((target->flags & TSO_BLOCKEX) &&
+	    ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
+	    blockedThrowTo(source,target);
+	    *out = target;
+	    return THROWTO_BLOCKED;
+	} else {
+	    raiseAsync(cap, target, exception, rtsFalse, NULL);
+	    unblockOne(cap, target);
+	    unlockTSO(target);
+	    return THROWTO_SUCCESS;
+	}
 
     case BlockedOnCCall:
     case BlockedOnCCall_NoUnblockExc:
diff --git a/rts/STM.c b/rts/STM.c
index 5c3b4341e2..01155b1107 100644
--- a/rts/STM.c
+++ b/rts/STM.c
@@ -328,15 +328,21 @@ static void park_tso(StgTSO *tso) {
 }
 
 static void unpark_tso(Capability *cap, StgTSO *tso) {
-  // We will continue unparking threads while they remain on one of the wait
-  // queues: it's up to the thread itself to remove it from the wait queues
-  // if it decides to do so when it is scheduled.
-  if (tso -> why_blocked == BlockedOnSTM) {
-    TRACE("unpark_tso on tso=%p\n", tso);
-    unblockOne(cap,tso);
-  } else {
-    TRACE("spurious unpark_tso on tso=%p\n", tso);
-  }
+    // We will continue unparking threads while they remain on one of the wait
+    // queues: it's up to the thread itself to remove it from the wait queues
+    // if it decides to do so when it is scheduled.
+
+    // Unblocking a TSO from BlockedOnSTM is done under the TSO lock,
+    // to avoid multiple CPUs unblocking the same TSO, and also to
+    // synchronise with throwTo().
+    lockTSO(tso);
+    if (tso -> why_blocked == BlockedOnSTM) {
+	TRACE("unpark_tso on tso=%p\n", tso);
+	unblockOne(cap,tso);
+    } else {
+	TRACE("spurious unpark_tso on tso=%p\n", tso);
+    }
+    unlockTSO(tso);
 }
 
 static void unpark_waiters_on(Capability *cap, StgTVar *s) {