X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=c0cfd7b275126e02725ced2c224b9c93e9d79840;hb=003c746e297163f59ffe826e4a7575fb0737ef93;hp=9041c06cb278c0513d02e291171168a95f4fbcd9;hpb=b1953bbb1ed3cb16497e5447db7487f0c2d9e41a;p=ghc-hetmet.git

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 9041c06..c0cfd7b 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -14,6 +14,7 @@
 #include "SMP.h"
 #include "Schedule.h"
 #include "Storage.h"
+#include "LdvProfile.h"
 #include "Updates.h"
 #include "STM.h"
 #include "Sanity.h"
@@ -153,8 +154,8 @@ throwTo (Capability *cap,	// the Capability we hold
 	// ASSERT(get_itbl(target)->type == TSO);
     }
 
-    debugTrace(DEBUG_sched, "throwTo: from thread %d to thread %d",
-	       source->id, target->id);
+    debugTrace(DEBUG_sched, "throwTo: from thread %lu to thread %lu",
+	       (unsigned long)source->id, (unsigned long)target->id);
 
 #ifdef DEBUG
     if (traceClass(DEBUG_sched)) {
@@ -240,7 +241,7 @@ check_target:
     {
 	Capability *target_cap;
 
-	wb();
+	write_barrier();
 	target_cap = target->cap;
 	if (target_cap == cap && (target->flags & TSO_BLOCKEX) == 0) {
 	    // It's on our run queue and not blocking exceptions
@@ -401,7 +402,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:
@@ -442,13 +459,13 @@ check_target:
 static void
 blockedThrowTo (StgTSO *source, StgTSO *target)
 {
-    debugTrace(DEBUG_sched, "throwTo: blocking on thread %d", target->id);
+    debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
     source->link = target->blocked_exceptions;
     target->blocked_exceptions = source;
     dirtyTSO(target); // we modified the blocked_exceptions queue
     
     source->block_info.tso = target;
-    wb(); // throwTo_exception *must* be visible if BlockedOnException is.
+    write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
     source->why_blocked = BlockedOnException;
 }