X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=6510ce8b07cb711924d482395d1243a2a812bcb6;hb=c5f93af1c663ab68f3b18f6a8c3264165a1c8883;hp=2ff916a70ad6c2f94a9d523c382285aaf338b883;hpb=8b18faef8aeaf40150c208272a2fc117611e8ae8;p=ghc-hetmet.git

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 2ff916a..6510ce8 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -8,17 +8,16 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+
+#include "sm/Storage.h"
 #include "Threads.h"
 #include "Trace.h"
 #include "RaiseAsync.h"
-#include "SMP.h"
 #include "Schedule.h"
-#include "LdvProfile.h"
 #include "Updates.h"
 #include "STM.h"
 #include "Sanity.h"
 #include "Profiling.h"
-#include "EventLog.h"
 #if defined(mingw32_HOST_OS)
 #include "win32/IOManager.h"
 #endif
@@ -162,11 +161,7 @@ throwTo (Capability *cap,	// the Capability we hold
 	       (unsigned long)source->id, (unsigned long)target->id);
 
 #ifdef DEBUG
-    if (traceClass(DEBUG_sched)) {
-	debugTraceBegin("throwTo: target");
-	printThreadStatus(target);
-	debugTraceEnd();
-    }
+    traceThreadStatus(DEBUG_sched, target);
 #endif
 
     goto check_target;
@@ -728,7 +723,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 #if defined(PROFILING)
     /* 
      * Debugging tool: on raising an  exception, show where we are.
-     * See also Exception.cmm:raisezh_fast.
+     * See also Exception.cmm:stg_raisezh.
      * This wasn't done for asynchronous exceptions originally; see #1450 
      */
     if (RtsFlags.ProfFlags.showCCSOnException)
@@ -891,7 +886,17 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 	    if (stop_at_atomically) {
 		ASSERT(stmGetEnclosingTRec(tso->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;
 	    }