Commit f0fcc41d authored by Simon Marlow's avatar Simon Marlow
Browse files

Revert "Per-thread allocation counters and limits"

Problems were found on 32-bit platforms, I'll commit again when I have a fix.

This reverts the following commits:
   54b31f74
   b0534f78
parent 5141baf7
...@@ -988,12 +988,9 @@ lowerSafeForeignCall dflags block ...@@ -988,12 +988,9 @@ lowerSafeForeignCall dflags block
id <- newTemp (bWord dflags) id <- newTemp (bWord dflags)
new_base <- newTemp (cmmRegType dflags (CmmGlobal BaseReg)) new_base <- newTemp (cmmRegType dflags (CmmGlobal BaseReg))
let (caller_save, caller_load) = callerSaveVolatileRegs dflags let (caller_save, caller_load) = callerSaveVolatileRegs dflags
load_tso <- newTemp (gcWord dflags)
load_stack <- newTemp (gcWord dflags) load_stack <- newTemp (gcWord dflags)
tso <- newTemp (gcWord dflags) let suspend = saveThreadState dflags <*>
cn <- newTemp (bWord dflags)
bdfree <- newTemp (bWord dflags)
bdstart <- newTemp (bWord dflags)
let suspend = saveThreadState dflags tso cn <*>
caller_save <*> caller_save <*>
mkMiddle (callSuspendThread dflags id intrbl) mkMiddle (callSuspendThread dflags id intrbl)
midCall = mkUnsafeCall tgt res args midCall = mkUnsafeCall tgt res args
...@@ -1002,7 +999,7 @@ lowerSafeForeignCall dflags block ...@@ -1002,7 +999,7 @@ lowerSafeForeignCall dflags block
-- might now have a different Capability! -- might now have a different Capability!
mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <*> mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <*>
caller_load <*> caller_load <*>
loadThreadState dflags tso load_stack cn bdfree bdstart loadThreadState dflags load_tso load_stack
(_, regs, copyout) = (_, regs, copyout) =
copyOutOflow dflags NativeReturn Jump (Young succ) copyOutOflow dflags NativeReturn Jump (Young succ)
......
...@@ -7,15 +7,12 @@ ...@@ -7,15 +7,12 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module StgCmmForeign ( module StgCmmForeign (
cgForeignCall, cgForeignCall, loadThreadState, saveThreadState,
emitPrimCall, emitCCall, emitPrimCall, emitCCall,
emitForeignCall, -- For CmmParse emitForeignCall, -- For CmmParse
emitSaveThreadState, emitSaveThreadState, -- will be needed by the Cmm parser
saveThreadState, emitLoadThreadState, -- ditto
emitLoadThreadState, emitCloseNursery, emitOpenNursery
loadThreadState,
emitOpenNursery,
emitCloseNursery,
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -267,215 +264,94 @@ maybe_assign_temp e = do ...@@ -267,215 +264,94 @@ maybe_assign_temp e = do
-- This stuff can't be done in suspendThread/resumeThread, because it -- This stuff can't be done in suspendThread/resumeThread, because it
-- refers to global registers which aren't available in the C world. -- refers to global registers which aren't available in the C world.
saveThreadState :: DynFlags -> CmmAGraph
saveThreadState dflags =
-- CurrentTSO->stackobj->sp = Sp;
mkStore (cmmOffset dflags (CmmLoad (cmmOffset dflags stgCurrentTSO (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags)) stgSp
<*> closeNursery dflags
-- and save the current cost centre stack in the TSO when profiling:
<*> if gopt Opt_SccProfilingOn dflags then
mkStore (cmmOffset dflags stgCurrentTSO (tso_CCCS dflags)) curCCS
else mkNop
emitSaveThreadState :: FCode () emitSaveThreadState :: FCode ()
emitSaveThreadState = do emitSaveThreadState = do
dflags <- getDynFlags dflags <- getDynFlags
tso <- newTemp (gcWord dflags) emit (saveThreadState dflags)
cn <- newTemp (bWord dflags)
emit $ saveThreadState dflags tso cn
-- saveThreadState must be usable from the stack layout pass, where we
-- don't have FCode. Therefore it takes LocalRegs as arguments, so
-- the caller can create these.
saveThreadState :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
saveThreadState dflags tso cn =
catAGraphs [
-- tso = CurrentTSO;
mkAssign (CmmLocal tso) stgCurrentTSO,
-- tso->stackobj->sp = Sp;
mkStore (cmmOffset dflags (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags)) stgSp,
closeNursery dflags tso cn,
-- and save the current cost centre stack in the TSO when profiling:
if gopt Opt_SccProfilingOn dflags then
mkStore (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) curCCS
else mkNop
]
emitCloseNursery :: FCode () emitCloseNursery :: FCode ()
emitCloseNursery = do emitCloseNursery = do
dflags <- getDynFlags df <- getDynFlags
tso <- newTemp (gcWord dflags) emit (closeNursery df)
cn <- newTemp (bWord dflags)
emit $ mkAssign (CmmLocal tso) stgCurrentTSO <*>
closeNursery dflags tso cn
{-
Closing the nursery corresponds to the following code:
tso = CurrentTSO;
cn = CurrentNuresry;
// Update the allocation limit for the current thread. We don't -- CurrentNursery->free = Hp+1;
// check to see whether it has overflowed at this point, that check is closeNursery :: DynFlags -> CmmAGraph
// made when we run out of space in the current heap block (stg_gc_noregs) closeNursery dflags = mkStore (nursery_bdescr_free dflags) (cmmOffsetW dflags stgHp 1)
// and in the scheduler when context switching (schedulePostRunThread).
tso->alloc_limit -= Hp + WDS(1) - cn->start;
// Set cn->free to the next unoccupied word in the block loadThreadState :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
cn->free = Hp + WDS(1); loadThreadState dflags tso stack = do
-}
closeNursery :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
closeNursery df tso cn =
let
tsoreg = CmmLocal tso
cnreg = CmmLocal cn
in
catAGraphs [ catAGraphs [
mkAssign cnreg stgCurrentNursery, -- tso = CurrentTSO;
mkAssign (CmmLocal tso) stgCurrentTSO,
let alloc = -- stack = tso->stackobj;
CmmMachOp (mo_wordSub df) mkAssign (CmmLocal stack) (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)),
[ cmmOffsetW df stgHp 1 -- Sp = stack->sp;
, CmmLoad (nursery_bdescr_start df cnreg) (bWord df) mkAssign sp (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),
] -- SpLim = stack->stack + RESERVED_STACK_WORDS;
mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
alloc_limit = cmmOffset df (CmmReg tsoreg) (tso_alloc_limit df) (rESERVED_STACK_WORDS dflags)),
in -- HpAlloc = 0;
-- HpAlloc is assumed to be set to non-zero only by a failed
-- tso->alloc_limit += alloc -- a heap check, see HeapStackCheck.cmm:GC_GENERIC
mkStore alloc_limit (CmmMachOp (mo_wordSub df) mkAssign hpAlloc (zeroExpr dflags),
[ CmmLoad alloc_limit b64
, alloc ]), openNursery dflags,
-- and load the current cost centre stack from the TSO when profiling:
-- CurrentNursery->free = Hp+1; if gopt Opt_SccProfilingOn dflags then
mkStore (nursery_bdescr_free df cnreg) (cmmOffsetW df stgHp 1) storeCurCCS
] (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) (ccsType dflags))
else mkNop]
emitLoadThreadState :: FCode () emitLoadThreadState :: FCode ()
emitLoadThreadState = do emitLoadThreadState = do
dflags <- getDynFlags dflags <- getDynFlags
tso <- newTemp (gcWord dflags) load_tso <- newTemp (gcWord dflags)
stack <- newTemp (gcWord dflags) load_stack <- newTemp (gcWord dflags)
cn <- newTemp (bWord dflags) emit $ loadThreadState dflags load_tso load_stack
bdfree <- newTemp (bWord dflags)
bdstart <- newTemp (bWord dflags)
emit $ loadThreadState dflags tso stack cn bdfree bdstart
-- loadThreadState must be usable from the stack layout pass, where we
-- don't have FCode. Therefore it takes LocalRegs as arguments, so
-- the caller can create these.
loadThreadState :: DynFlags
-> LocalReg -> LocalReg -> LocalReg -> LocalReg -> LocalReg
-> CmmAGraph
loadThreadState dflags tso stack cn bdfree bdstart =
catAGraphs [
-- tso = CurrentTSO;
mkAssign (CmmLocal tso) stgCurrentTSO,
-- stack = tso->stackobj;
mkAssign (CmmLocal stack) (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)),
-- Sp = stack->sp;
mkAssign sp (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),
-- SpLim = stack->stack + RESERVED_STACK_WORDS;
mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
(rESERVED_STACK_WORDS dflags)),
-- HpAlloc = 0;
-- HpAlloc is assumed to be set to non-zero only by a failed
-- a heap check, see HeapStackCheck.cmm:GC_GENERIC
mkAssign hpAlloc (zeroExpr dflags),
openNursery dflags tso cn bdfree bdstart,
-- and load the current cost centre stack from the TSO when profiling:
if gopt Opt_SccProfilingOn dflags
then storeCurCCS
(CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso))
(tso_CCCS dflags)) (ccsType dflags))
else mkNop
]
emitOpenNursery :: FCode () emitOpenNursery :: FCode ()
emitOpenNursery = do emitOpenNursery = do
dflags <- getDynFlags df <- getDynFlags
tso <- newTemp (gcWord dflags) emit (openNursery df)
cn <- newTemp (bWord dflags)
bdfree <- newTemp (bWord dflags) openNursery :: DynFlags -> CmmAGraph
bdstart <- newTemp (bWord dflags) openNursery dflags = catAGraphs [
emit $ mkAssign (CmmLocal tso) stgCurrentTSO <*> -- Hp = CurrentNursery->free - 1;
openNursery dflags tso cn bdfree bdstart mkAssign hp (cmmOffsetW dflags (CmmLoad (nursery_bdescr_free dflags) (bWord dflags)) (-1)),
{- -- HpLim = CurrentNursery->start +
Opening the nursery corresponds to the following code: -- CurrentNursery->blocks*BLOCK_SIZE_W - 1;
mkAssign hpLim
tso = CurrentTSO; (cmmOffsetExpr dflags
cn = CurrentNursery; (CmmLoad (nursery_bdescr_start dflags) (bWord dflags))
bdfree = CurrentNuresry->free; (cmmOffset dflags
bdstart = CurrentNuresry->start; (CmmMachOp (mo_wordMul dflags) [
CmmMachOp (MO_SS_Conv W32 (wordWidth dflags))
// We *add* the currently occupied portion of the nursery block to [CmmLoad (nursery_bdescr_blocks dflags) b32],
// the allocation limit, because we will subtract it again in mkIntExpr dflags (bLOCK_SIZE dflags)
// closeNursery. ])
tso->alloc_limit += bdfree - bdstart; (-1)
)
// Set Hp to the last occupied word of the heap block. Why not the )
// next unocupied word? Doing it this way means that we get to use
// an offset of zero more often, which might lead to slightly smaller
// code on some architectures.
Hp = bdfree - WDS(1);
// Set HpLim to the end of the current nursery block (note that this block
// might be a block group, consisting of several adjacent blocks.
HpLim = bdstart + CurrentNursery->blocks*BLOCK_SIZE_W - 1;
-}
openNursery :: DynFlags
-> LocalReg -> LocalReg -> LocalReg -> LocalReg
-> CmmAGraph
openNursery df tso cn bdfree bdstart =
let
tsoreg = CmmLocal tso
cnreg = CmmLocal cn
bdfreereg = CmmLocal bdfree
bdstartreg = CmmLocal bdstart
in
catAGraphs [
mkAssign cnreg stgCurrentNursery,
mkAssign bdfreereg (CmmLoad (nursery_bdescr_free df cnreg) (bWord df)),
mkAssign bdstartreg (CmmLoad (nursery_bdescr_start df cnreg) (bWord df)),
-- alloc = bd->free - bd->start
let alloc =
CmmMachOp (mo_wordSub df) [CmmReg bdfreereg, CmmReg bdstartreg]
alloc_limit = cmmOffset df (CmmReg tsoreg) (tso_alloc_limit df)
in
-- tso->alloc_limit += alloc
mkStore alloc_limit (CmmMachOp (mo_wordAdd df)
[ CmmLoad alloc_limit b64
, alloc ]),
-- Hp = CurrentNursery->free - 1;
mkAssign hp (cmmOffsetW df (CmmReg bdfreereg) (-1)),
-- HpLim = CurrentNursery->start +
-- CurrentNursery->blocks*BLOCK_SIZE_W - 1;
mkAssign hpLim
(cmmOffsetExpr df
(CmmReg bdstartreg)
(cmmOffset df
(CmmMachOp (mo_wordMul df) [
CmmMachOp (MO_SS_Conv W32 (wordWidth df))
[CmmLoad (nursery_bdescr_blocks df cnreg) b32],
mkIntExpr df (bLOCK_SIZE df)
])
(-1)
)
)
] ]
nursery_bdescr_free, nursery_bdescr_start, nursery_bdescr_blocks nursery_bdescr_free, nursery_bdescr_start, nursery_bdescr_blocks :: DynFlags -> CmmExpr
:: DynFlags -> CmmReg -> CmmExpr nursery_bdescr_free dflags = cmmOffset dflags stgCurrentNursery (oFFSET_bdescr_free dflags)
nursery_bdescr_free dflags cn = nursery_bdescr_start dflags = cmmOffset dflags stgCurrentNursery (oFFSET_bdescr_start dflags)
cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_free dflags) nursery_bdescr_blocks dflags = cmmOffset dflags stgCurrentNursery (oFFSET_bdescr_blocks dflags)
nursery_bdescr_start dflags cn =
cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_start dflags)
nursery_bdescr_blocks dflags cn =
cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_blocks dflags)
tso_stackobj, tso_CCCS, tso_alloc_limit, stack_STACK, stack_SP :: DynFlags -> ByteOff tso_stackobj, tso_CCCS, stack_STACK, stack_SP :: DynFlags -> ByteOff
tso_stackobj dflags = closureField dflags (oFFSET_StgTSO_stackobj dflags) tso_stackobj dflags = closureField dflags (oFFSET_StgTSO_stackobj dflags)
tso_alloc_limit dflags = closureField dflags (oFFSET_StgTSO_alloc_limit dflags)
tso_CCCS dflags = closureField dflags (oFFSET_StgTSO_cccs dflags) tso_CCCS dflags = closureField dflags (oFFSET_StgTSO_cccs dflags)
stack_STACK dflags = closureField dflags (oFFSET_StgStack_stack dflags) stack_STACK dflags = closureField dflags (oFFSET_StgStack_stack dflags)
stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags) stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags)
......
...@@ -741,8 +741,10 @@ globalRegMaybe CurrentTSO = Just (RealRegSingle REG_CurrentTSO) ...@@ -741,8 +741,10 @@ globalRegMaybe CurrentTSO = Just (RealRegSingle REG_CurrentTSO)
# ifdef REG_CurrentNursery # ifdef REG_CurrentNursery
globalRegMaybe CurrentNursery = Just (RealRegSingle REG_CurrentNursery) globalRegMaybe CurrentNursery = Just (RealRegSingle REG_CurrentNursery)
# endif # endif
#endif
globalRegMaybe _ = Nothing globalRegMaybe _ = Nothing
#else
globalRegMaybe = panic "globalRegMaybe not defined for this platform"
#endif
freeReg :: RegNo -> FastBool freeReg :: RegNo -> FastBool
......
...@@ -274,12 +274,6 @@ ...@@ -274,12 +274,6 @@
*/ */
#define TSO_SQUEEZED 128 #define TSO_SQUEEZED 128
/*
* Enables the AllocationLimitExceeded exception when the thread's
* allocation limit goes negative.
*/
#define TSO_ALLOC_LIMIT 256
/* /*
* The number of times we spin in a spin lock before yielding (see * The number of times we spin in a spin lock before yielding (see
* #3758). To tune this value, use the benchmark in #3758: run the * #3758). To tune this value, use the benchmark in #3758: run the
......
...@@ -56,14 +56,6 @@ struct GC_FLAGS { ...@@ -56,14 +56,6 @@ struct GC_FLAGS {
rtsBool doIdleGC; rtsBool doIdleGC;
StgWord heapBase; /* address to ask the OS for memory */ StgWord heapBase; /* address to ask the OS for memory */
StgWord allocLimitGrace; /* units: *blocks*
* After an AllocationLimitExceeded
* exception has been raised, how much
* extra space is given to the thread
* to handle the exception before we
* raise it again.
*/
}; };
struct DEBUG_FLAGS { struct DEBUG_FLAGS {
......
...@@ -42,12 +42,8 @@ StgRegTable * resumeThread (void *); ...@@ -42,12 +42,8 @@ StgRegTable * resumeThread (void *);
// //
// Thread operations from Threads.c // Thread operations from Threads.c
// //
int cmp_thread (StgPtr tso1, StgPtr tso2); int cmp_thread (StgPtr tso1, StgPtr tso2);
int rts_getThreadId (StgPtr tso); int rts_getThreadId (StgPtr tso);
HsInt64 rts_getThreadAllocationCounter (StgPtr tso);
void rts_setThreadAllocationCounter (StgPtr tso, HsInt64 i);
void rts_enableThreadAllocationLimit (StgPtr tso);
void rts_disableThreadAllocationLimit (StgPtr tso);
#if !defined(mingw32_HOST_OS) #if !defined(mingw32_HOST_OS)
pid_t forkProcess (HsStablePtr *entry); pid_t forkProcess (HsStablePtr *entry);
......
...@@ -145,18 +145,15 @@ typedef struct StgTSO_ { ...@@ -145,18 +145,15 @@ typedef struct StgTSO_ {
*/ */
struct StgBlockingQueue_ *bq; struct StgBlockingQueue_ *bq;
/* #ifdef TICKY_TICKY
* The allocation limit for this thread, which is updated as the /* TICKY-specific stuff would go here. */
* thread allocates. If the value drops below zero, and #endif
* TSO_ALLOC_LIMIT is set in flags, we raise an exception in the #ifdef PROFILING
* thread, and give the thread a little more space to handle the StgTSOProfInfo prof;
* exception before we raise the exception again. #endif
* #ifdef mingw32_HOST_OS
* This is an integer, because we might update it in a place where StgWord32 saved_winerror;
* it isn't convenient to raise the exception, so we want it to #endif
* stay negative until we get around to checking it.
*/
StgInt64 alloc_limit; /* in bytes */
/* /*
* sum of the sizes of all stack chunks (in words), used to decide * sum of the sizes of all stack chunks (in words), used to decide
...@@ -171,16 +168,6 @@ typedef struct StgTSO_ { ...@@ -171,16 +168,6 @@ typedef struct StgTSO_ {
*/ */
StgWord32 tot_stack_size; StgWord32 tot_stack_size;
#ifdef TICKY_TICKY
/* TICKY-specific stuff would go here. */
#endif
#ifdef PROFILING
StgTSOProfInfo prof;
#endif
#ifdef mingw32_HOST_OS
StgWord32 saved_winerror;
#endif
} *StgTSOPtr; } *StgTSOPtr;
typedef struct StgStack_ { typedef struct StgStack_ {
......
...@@ -48,7 +48,6 @@ module Control.Exception ( ...@@ -48,7 +48,6 @@ module Control.Exception (
NestedAtomically(..), NestedAtomically(..),
BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..), BlockedIndefinitelyOnSTM(..),
AllocationLimitExceeded(..),
Deadlock(..), Deadlock(..),
NoMethodError(..), NoMethodError(..),
PatternMatchFail(..), PatternMatchFail(..),
......
...@@ -31,7 +31,6 @@ module Control.Exception.Base ( ...@@ -31,7 +31,6 @@ module Control.Exception.Base (
NestedAtomically(..), NestedAtomically(..),
BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..), BlockedIndefinitelyOnSTM(..),
AllocationLimitExceeded(..),
Deadlock(..), Deadlock(..),
NoMethodError(..), NoMethodError(..),
PatternMatchFail(..), PatternMatchFail(..),
......
...@@ -60,12 +60,6 @@ module GHC.Conc ...@@ -60,12 +60,6 @@ module GHC.Conc
, threadWaitWriteSTM , threadWaitWriteSTM
, closeFdWith , closeFdWith
-- * Allocation counter and limit
, setAllocationCounter
, getAllocationCounter
, enableAllocationLimit
, disableAllocationLimit
-- * TVars -- * TVars
, STM(..) , STM(..)
, atomically , atomically
......
...@@ -61,12 +61,6 @@ module GHC.Conc.Sync ...@@ -61,12 +61,6 @@ module GHC.Conc.Sync
, threadStatus , threadStatus
, threadCapability , threadCapability
-- * Allocation counter and quota
, setAllocationCounter
, getAllocationCounter
, enableAllocationLimit
, disableAllocationLimit
-- * TVars -- * TVars
, STM(..) , STM(..)
, atomically , atomically
...@@ -183,92 +177,16 @@ instance Eq ThreadId where ...@@ -183,92 +177,16 @@ instance Eq ThreadId where
instance Ord ThreadId where instance Ord ThreadId where
compare = cmpThread compare = cmpThread
-- | Every thread has an allocation counter that tracks how much
-- memory has been allocated by the thread. The counter is
-- initialized to zero, and 'setAllocationCounter' sets the current
-- value. The allocation counter counts *down*, so in the absence of
-- a call to 'setAllocationCounter' its value is the negation of the
-- number of bytes of memory allocated by the thread.
--
-- There are two things that you can do with this counter:
--
-- * Use it as a simple profiling mechanism, with
-- 'getAllocationCounter'.
--
-- * Use it as a resource limit. See 'enableAllocationLimit'.
--
-- Allocation accounting is accurate only to about 4Kbytes.
--
setAllocationCounter :: Int64 -> IO ()
setAllocationCounter i = do
ThreadId t <- myThreadId
rts_setThreadAllocationCounter t i
-- | Return the current value of the allocation counter for the
-- current thread.
getAllocationCounter :: IO Int64
getAllocationCounter = do
ThreadId t <- myThreadId
rts_getThreadAllocationCounter t
-- | Enables the allocation counter to be treated as a limit for the
-- current thread. When the allocation limit is enabled, if the
-- allocation counter counts down below zero, the thread will be sent
-- the 'AllocationLimitExceeded' asynchronous exception. When this
-- happens, the counter is reinitialised (by default
-- to 100K, but tunable with the @+RTS -xq@ option) so that it can handle
-- the exception and perform any necessary clean up. If it exhausts
-- this additional allowance, another 'AllocationLimitExceeded' exception
-- is sent, and so forth.
--
-- Note that memory allocation is unrelated to /live memory/, also
-- known as /heap residency/. A thread can allocate a large amount of
-- memory and retain anything between none and all of it. It is
-- better to think of the allocation limit as a limit on
-- /CPU time/, rather than a limit on memory.
--
-- Compared to using timeouts, allocation limits don't count time
-- spent blocked or in foreign calls.
--
enableAllocationLimit :: IO ()
enableAllocationLimit = do
ThreadId t <- myThreadId
rts_enableThreadAllocationLimit t
-- | Disable allocation limit processing for the current thread.
disableAllocationLimit :: IO ()