diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2014-04-28 16:55:47 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2014-05-02 14:49:22 +0100 |
| commit | b0534f78a73f972e279eed4447a5687bd6a8308e (patch) | |
| tree | 02d52756620bf27b9df9db45c57dacf55f190842 /compiler/cmm/CmmLayoutStack.hs | |
| parent | 34db5ccf52ec2a1b5e953c282d0c52a7fc82c02a (diff) | |
| download | haskell-b0534f78a73f972e279eed4447a5687bd6a8308e.tar.gz | |
Per-thread allocation counters and limits
This tracks the amount of memory allocation by each thread in a
counter stored in the TSO. Optionally, when the counter drops below
zero (it counts down), the thread can be sent an asynchronous
exception: AllocationLimitExceeded. When this happens, given a small
additional limit so that it can handle the exception. See
documentation in GHC.Conc for more details.
Allocation limits are similar to timeouts, but
- timeouts use real time, not CPU time. Allocation limits do not
count anything while the thread is blocked or in foreign code.
- timeouts don't re-trigger if the thread catches the exception,
allocation limits do.
- timeouts can catch non-allocating loops, if you use
-fno-omit-yields. This doesn't work for allocation limits.
I couldn't measure any impact on benchmarks with these changes, even
for nofib/smp.
Diffstat (limited to 'compiler/cmm/CmmLayoutStack.hs')
| -rw-r--r-- | compiler/cmm/CmmLayoutStack.hs | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index bdc947829d..e7d57d550a 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -988,9 +988,12 @@ lowerSafeForeignCall dflags block id <- newTemp (bWord dflags) new_base <- newTemp (cmmRegType dflags (CmmGlobal BaseReg)) let (caller_save, caller_load) = callerSaveVolatileRegs dflags - load_tso <- newTemp (gcWord dflags) load_stack <- newTemp (gcWord dflags) - let suspend = saveThreadState dflags <*> + tso <- newTemp (gcWord dflags) + cn <- newTemp (bWord dflags) + bdfree <- newTemp (bWord dflags) + bdstart <- newTemp (bWord dflags) + let suspend = saveThreadState dflags tso cn <*> caller_save <*> mkMiddle (callSuspendThread dflags id intrbl) midCall = mkUnsafeCall tgt res args @@ -999,7 +1002,7 @@ lowerSafeForeignCall dflags block -- might now have a different Capability! mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <*> caller_load <*> - loadThreadState dflags load_tso load_stack + loadThreadState dflags tso load_stack cn bdfree bdstart (_, regs, copyout) = copyOutOflow dflags NativeReturn Jump (Young succ) |