micro-opt: replace stmGetEnclosingTRec() with a field access

[ghc-hetmet.git] / rts / RaiseAsync.c

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 4ca1cba..a0f78ee 100644 (file)
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -18,7 +18,6 @@
 #include "STM.h"
 #include "Sanity.h"
 #include "Profiling.h"
-#include "eventlog/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;
@@ -889,9 +884,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;
            }
@@ -909,7 +914,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);