X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=ca5e5ea4c1481ef418bfaaa6c36349b3b90e34ba;hb=9a977e72a47a0e0c2a8bbf254f8b85609f0937f9;hp=3078cf90ad9cb05bb68cdd083fef1147db8bf01d;hpb=a5288c551349a0adab0d931a429b10a096d9444d;p=ghc-hetmet.git

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 3078cf9..ca5e5ea 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -16,7 +16,7 @@
 #include "Schedule.h"
 #include "Updates.h"
 #include "STM.h"
-#include "Sanity.h"
+#include "sm/Sanity.h"
 #include "Profiling.h"
 #if defined(mingw32_HOST_OS)
 #include "win32/IOManager.h"
@@ -143,13 +143,15 @@ suspendComputation(Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
 
 nat
 throwTo (Capability *cap,	// the Capability we hold 
-	 StgTSO *source,	// the TSO sending the exception
+	 StgTSO *source,	// the TSO sending the exception (or NULL)
 	 StgTSO *target,        // the TSO receiving the exception
 	 StgClosure *exception, // the exception closure
 	 /*[out]*/ void **out USED_IF_THREADS)
 {
     StgWord status;
 
+    ASSERT(target != END_TSO_QUEUE);
+
     // follow ThreadRelocated links in the target first
     while (target->what_next == ThreadRelocated) {
 	target = target->_link;
@@ -157,8 +159,13 @@ throwTo (Capability *cap,	// the Capability we hold
 	// ASSERT(get_itbl(target)->type == TSO);
     }
 
-    debugTrace(DEBUG_sched, "throwTo: from thread %lu to thread %lu",
-	       (unsigned long)source->id, (unsigned long)target->id);
+    if (source != NULL) {
+        debugTrace(DEBUG_sched, "throwTo: from thread %lu to thread %lu",
+                   (unsigned long)source->id, (unsigned long)target->id);
+    } else {
+        debugTrace(DEBUG_sched, "throwTo: from RTS to thread %lu",
+                   (unsigned long)target->id);
+    }
 
 #ifdef DEBUG
     traceThreadStatus(DEBUG_sched, target);
@@ -169,6 +176,8 @@ retry:
     debugTrace(DEBUG_sched, "throwTo: retrying...");
 
 check_target:
+    ASSERT(target != END_TSO_QUEUE);
+
     // Thread already dead?
     if (target->what_next == ThreadComplete 
 	|| target->what_next == ThreadKilled) {
@@ -482,14 +491,16 @@ check_target:
 static void
 blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target)
 {
-    debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
-    setTSOLink(cap, source, target->blocked_exceptions);
-    target->blocked_exceptions = source;
-    dirty_TSO(cap,target); // we modified the blocked_exceptions queue
-    
-    source->block_info.tso = target;
-    write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
-    source->why_blocked = BlockedOnException;
+    if (source != NULL) {
+        debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
+        setTSOLink(cap, source, target->blocked_exceptions);
+        target->blocked_exceptions = source;
+        dirty_TSO(cap,target); // we modified the blocked_exceptions queue
+        
+        source->block_info.tso = target;
+        write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
+        source->why_blocked = BlockedOnException;
+    }
 }
 
 
@@ -792,7 +803,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 	    // fun field.
 	    //
 	    words = frame - sp - 1;
-	    ap = (StgAP_STACK *)allocateLocal(cap,AP_STACK_sizeW(words));
+	    ap = (StgAP_STACK *)allocate(cap,AP_STACK_sizeW(words));
 	    
 	    ap->size = words;
 	    ap->fun  = (StgClosure *)sp[0];
@@ -823,7 +834,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
                 // Perform the update
                 // TODO: this may waste some work, if the thunk has
                 // already been updated by another thread.
-                UPD_IND(((StgUpdateFrame *)frame)->updatee, (StgClosure *)ap);
+                UPD_IND(cap, ((StgUpdateFrame *)frame)->updatee, (StgClosure *)ap);
             }
 
 	    sp += sizeofW(StgUpdateFrame) - 1;
@@ -856,7 +867,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 	    // we've got an exception to raise, so let's pass it to the
 	    // handler in this frame.
 	    //
-	    raise = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
+	    raise = (StgThunk *)allocate(cap,sizeofW(StgThunk)+1);
 	    TICK_ALLOC_SE_THK(1,0);
 	    SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
 	    raise->payload[0] = exception;
@@ -884,9 +895,19 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 	    
 	case ATOMICALLY_FRAME:
 	    if (stop_at_atomically) {
-		ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
+		ASSERT(tso->trec->enclosing_trec == NO_TREC);
 		stmCondemnTransaction(cap, tso -> trec);
-		tso->sp = frame;
+		tso->sp = frame - 2;
+                // The ATOMICALLY_FRAME expects to be returned a
+                // result from the transaction, which it stores in the
+                // stack frame.  Hence we arrange to return a dummy
+                // result, so that the GC doesn't get upset (#3578).
+                // Perhaps a better way would be to have a different
+                // ATOMICALLY_FRAME instance for condemned
+                // transactions, but I don't fully understand the
+                // interaction with STM invariants.
+                tso->sp[1] = (W_)&stg_NO_TREC_closure;
+                tso->sp[0] = (W_)&stg_gc_unpt_r1_info;
 		tso->what_next = ThreadRunGHC;
 		return;
 	    }
@@ -904,7 +925,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 
 		{
             StgTRecHeader *trec = tso -> trec;
-            StgTRecHeader *outer = stmGetEnclosingTRec(trec);
+            StgTRecHeader *outer = trec -> enclosing_trec;
 	    debugTrace(DEBUG_stm, 
 		       "found atomically block delivering async exception");
             stmAbortTransaction(cap, trec);