From: simonmar <unknown>
Date: Tue, 13 Dec 2005 15:57:50 +0000 (+0000)
Subject: [project @ 2005-12-13 15:57:49 by simonmar]
X-Git-Tag: final_switch_to_darcs,_this_repo_is_now_live~92
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=11d4497ccdbc6758ea9d0a6deff0f2794c03b76c;p=ghc-hetmet.git

[project @ 2005-12-13 15:57:49 by simonmar]
Raise the (new) exception NestedAtomically when atomically is nested
(using unsafePerformIO).  This is a small improvement over crashing.
---

diff --git a/ghc/rts/Prelude.h b/ghc/rts/Prelude.h
index 3faf30c..c209b2b 100644
--- a/ghc/rts/Prelude.h
+++ b/ghc/rts/Prelude.h
@@ -40,6 +40,7 @@ PRELUDE_CLOSURE(GHCziIOBase_heapOverflow_closure);
 PRELUDE_CLOSURE(GHCziIOBase_BlockedOnDeadMVar_closure);
 PRELUDE_CLOSURE(GHCziIOBase_BlockedIndefinitely_closure);
 PRELUDE_CLOSURE(GHCziIOBase_NonTermination_closure);
+PRELUDE_CLOSURE(GHCziIOBase_NestedAtomically_closure);
 
 PRELUDE_INFO(GHCziBase_Czh_static_info);
 PRELUDE_INFO(GHCziBase_Izh_static_info);
@@ -87,6 +88,7 @@ PRELUDE_INFO(GHCziStable_StablePtr_con_info);
 #define BlockedOnDeadMVar_closure (&GHCziIOBase_BlockedOnDeadMVar_closure)
 #define BlockedIndefinitely_closure (&GHCziIOBase_BlockedIndefinitely_closure)
 #define NonTermination_closure    (&GHCziIOBase_NonTermination_closure)
+#define NestedAtomically_closure  (&GHCziIOBase_NestedAtomically_closure)
 
 #define Czh_static_info           (&GHCziBase_Czh_static_info)
 #define Fzh_static_info           (&GHCziFloat_Fzh_static_info)
diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
index 84b81dc..a3f5144 100644
--- a/ghc/rts/PrimOps.cmm
+++ b/ghc/rts/PrimOps.cmm
@@ -1172,6 +1172,14 @@ atomicallyzh_fast
   /* Args: R1 = m :: STM a */
   STK_CHK_GEN(SIZEOF_StgAtomicallyFrame + WDS(1), R1_PTR, atomicallyzh_fast);
 
+  old_trec = StgTSO_trec(CurrentTSO);
+
+  /* Nested transactions are not allowed; raise an exception */
+  if (old_trec != NO_TREC) {
+     R1 = GHCziIOBase_NestedAtomically_closure;
+     jump raisezh_fast;
+  }
+
   /* Set up the atomically frame */
   Sp = Sp - SIZEOF_StgAtomicallyFrame;
   frame = Sp;
@@ -1180,8 +1188,6 @@ atomicallyzh_fast
   StgAtomicallyFrame_code(frame) = R1;
 
   /* Start the memory transcation */
-  old_trec = StgTSO_trec(CurrentTSO);
-  ASSERT(old_trec == NO_TREC);
   "ptr" new_trec = foreign "C" stmStartTransaction(MyCapability() "ptr", old_trec "ptr");
   StgTSO_trec(CurrentTSO) = new_trec;