diff options
author | Austin Seipp <aseipp@pobox.com> | 2013-09-08 16:17:36 -0500 |
---|---|---|
committer | Austin Seipp <aseipp@pobox.com> | 2013-09-08 16:17:36 -0500 |
commit | 88dba610df290ff7807a76f702f2e5d41887500b (patch) | |
tree | e1324062ceef817866771e5bb3f4a93151ba3fb4 /rts/sm/Storage.c | |
parent | c798a8c6c66d826efdc0201fa56d45337eecc2af (diff) | |
download | haskell-88dba610df290ff7807a76f702f2e5d41887500b.tar.gz |
Revert "Default to infinite stack size (#8189)"
This reverts commit d85044f6b201eae0a9e453b89c0433608e0778f0.
Diffstat (limited to 'rts/sm/Storage.c')
-rw-r--r-- | rts/sm/Storage.c | 55 |
1 files changed, 16 insertions, 39 deletions
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index df088132e3..b575fc3e52 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -624,27 +624,27 @@ move_STACK (StgStack *src, StgStack *dest) } /* ----------------------------------------------------------------------------- - allocateFail() + allocate() This allocates memory in the current thread - it is intended for - use primarily from STG-land where we have a Capability. + use primarily from STG-land where we have a Capability. It is + better than allocate() because it doesn't require taking the + sm_mutex lock in the common case. Memory is allocated directly from the nursery if possible (but not from the current nursery block, so as not to interfere with Hp/HpLim). - - We return NULL in the event of a heap overflow. -------------------------------------------------------------------------- */ StgPtr -allocateFail (Capability *cap, W_ n) +allocate (Capability *cap, W_ n) { bdescr *bd; StgPtr p; TICK_ALLOC_HEAP_NOCTR(WDS(n)); CCS_ALLOC(cap->r.rCCCS,n); - + if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { W_ req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; @@ -655,7 +655,14 @@ allocateFail (Capability *cap, W_ n) req_blocks >= HS_INT32_MAX) // avoid overflow when // calling allocGroup() below { - return NULL; // heap overflow + heapOverflow(); + // heapOverflow() doesn't exit (see #2592), but we aren't + // in a position to do a clean shutdown here: we + // either have to allocate the memory or exit now. + // Allocating the memory would be bad, because the user + // has requested that we not exceed maxHeapSize, so we + // just exit. + stg_exit(EXIT_HEAPOVERFLOW); } ACQUIRE_SM_LOCK @@ -675,12 +682,12 @@ allocateFail (Capability *cap, W_ n) bd = cap->r.rCurrentAlloc; if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) { - + // The CurrentAlloc block is full, we need to find another // one. First, we try taking the next block from the // nursery: bd = cap->r.rCurrentNursery->link; - + if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) { // The nursery is empty, or the next block is already // full: allocate a fresh block (we can't fail here). @@ -713,36 +720,6 @@ allocateFail (Capability *cap, W_ n) return p; } -/* ----------------------------------------------------------------------------- - allocate() - - This allocates memory in the current thread - it is intended for - use primarily from STG-land where we have a Capability. - - Memory is allocated directly from the nursery if possible (but not - from the current nursery block, so as not to interfere with - Hp/HpLim). - - We crash with a HeapOverflow when the allocation fails. - -------------------------------------------------------------------------- */ - -StgPtr -allocate (Capability *cap, W_ n) -{ - StgPtr p = allocateFail(cap, n); - if (p == NULL) { - heapOverflow(); - // heapOverflow() doesn't exit (see #2592), but we aren't - // in a position to do a clean shutdown here: we - // either have to allocate the memory or exit now. - // Allocating the memory would be bad, because the user - // has requested that we not exceed maxHeapSize, so we - // just exit. - stg_exit(EXIT_HEAPOVERFLOW); - } - return p; -} - /* --------------------------------------------------------------------------- Allocate a fixed/pinned object. |