X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=0e54b65402bb43ca86d8bf723e493bcd52ba1a3b;hb=5ad61e1470db6dbc8279569c5ad1cc093f753ac0;hp=585ddec0ef852ef4ffb7b72cfde1c32b7355ef5a;hpb=93db1991b5cacf8357493a2e17fbbfb485f3205b;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 585ddec..0e54b65 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -3039,8 +3039,9 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
    This should either be a CATCH_RETRY_FRAME (if the retry# is within an orElse#) 
    or should be a ATOMICALLY_FRAME (if the retry# reaches the top level).  
 
-   We skip CATCH_STM_FRAMEs because retries are not considered to be exceptions,
-   despite the similar implementation.
+   We skip CATCH_STM_FRAMEs (aborting and rolling back the nested tx that they
+   create) because retries are not considered to be exceptions, despite the
+   similar implementation.
 
    We should not expect to see CATCH_FRAME or STOP_FRAME because those should
    not be created within memory transactions.
@@ -3060,7 +3061,7 @@ findRetryFrameHelper (StgTSO *tso)
       
     case ATOMICALLY_FRAME:
 	debugTrace(DEBUG_stm,
-		   "found ATOMICALLY_FRAME at %p during retrry", p);
+		   "found ATOMICALLY_FRAME at %p during retry", p);
 	tso->sp = p;
 	return ATOMICALLY_FRAME;
       
@@ -3070,7 +3071,20 @@ findRetryFrameHelper (StgTSO *tso)
 	tso->sp = p;
 	return CATCH_RETRY_FRAME;
       
-    case CATCH_STM_FRAME:
+    case CATCH_STM_FRAME: {
+        debugTrace(DEBUG_stm,
+		   "found CATCH_STM_FRAME at %p during retry", p);
+        StgTRecHeader *trec = tso -> trec;
+	StgTRecHeader *outer = stmGetEnclosingTRec(trec);
+        debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer);
+	stmAbortTransaction(tso -> cap, trec);
+	stmFreeAbortedTRec(tso -> cap, trec);
+	tso -> trec = outer;
+        p = next; 
+        continue;
+    }
+      
+
     default:
       ASSERT(info->i.type != CATCH_FRAME);
       ASSERT(info->i.type != STOP_FRAME);