[commit: ghc] master: Fix segfault with STM; fixes #8035. Patch from errge. (60cb478)

[Ian Lynagh]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/60cb478f16c0703e0e97a528869905333d9b3135

>---------------------------------------------------------------

commit 60cb478f16c0703e0e97a528869905333d9b3135
Author: Ian Lynagh <ian at well-typed.com>
Date:   Sun Jul 7 19:13:31 2013 +0100

    Fix segfault with STM; fixes #8035. Patch from errge.

>---------------------------------------------------------------

 rts/Schedule.c | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/rts/Schedule.c b/rts/Schedule.c
index a024926..88bfd8c 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -2722,7 +2722,19 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
             tso->stackobj->sp = p;
 	    return STOP_FRAME;
 
-        case CATCH_RETRY_FRAME:
+        case CATCH_RETRY_FRAME: {
+            StgTRecHeader *trec = tso -> trec;
+            StgTRecHeader *outer = trec -> enclosing_trec;
+            debugTrace(DEBUG_stm,
+                       "found CATCH_RETRY_FRAME at %p during raise", p);
+            debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer);
+            stmAbortTransaction(cap, trec);
+            stmFreeAbortedTRec(cap, trec);
+            tso -> trec = outer;
+            p = next;
+            continue;
+        }
+
 	default:
 	    p = next; 
 	    continue;