diff options
author | simonmar <unknown> | 2005-12-13 15:57:50 +0000 |
---|---|---|
committer | simonmar <unknown> | 2005-12-13 15:57:50 +0000 |
commit | 11d4497ccdbc6758ea9d0a6deff0f2794c03b76c (patch) | |
tree | 4a0873159e71a156aadb1ace9ea0dac9ecf384f7 | |
parent | 83ec76b21158a4f6629e6c01947aa2793c264809 (diff) | |
download | haskell-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.h | 2 | ||||
-rw-r--r-- | ghc/rts/PrimOps.cmm | 10 |
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; |