summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonmar <unknown>2005-12-13 15:57:50 +0000
committersimonmar <unknown>2005-12-13 15:57:50 +0000
commit11d4497ccdbc6758ea9d0a6deff0f2794c03b76c (patch)
tree4a0873159e71a156aadb1ace9ea0dac9ecf384f7
parent83ec76b21158a4f6629e6c01947aa2793c264809 (diff)
downloadhaskell-11d4497ccdbc6758ea9d0a6deff0f2794c03b76c.tar.gz
[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.
-rw-r--r--ghc/rts/Prelude.h2
-rw-r--r--ghc/rts/PrimOps.cmm10
2 files changed, 10 insertions, 2 deletions
diff --git a/ghc/rts/Prelude.h b/ghc/rts/Prelude.h
index 3faf30c1ac..c209b2b800 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 84b81dc46b..a3f5144df0 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;