StgPtr
allocate (Capability *cap, W_ n)
{
bdescr *bd;
StgPtr p;
TICK_ALLOC_HEAP_NOCTR(WDS(n));
CCS_ALLOC(cap->r.rCCCS,n);
if (cap->r.rCurrentTSO != NULL) {
// cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_)
ASSIGN_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit),
(PK_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit))
- n*sizeof(W_)));
}
if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
// The largest number of words such that
// the computation of req_blocks will not overflow.
W_ max_words = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_);
W_ req_blocks;
if (n > max_words)
req_blocks = HS_WORD_MAX; // signal overflow below
else
req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
// Attempting to allocate an object larger than maxHeapSize
// should definitely be disallowed. (bug #1791)
if ((RtsFlags.GcFlags.maxHeapSize > 0 &&
req_blocks >= RtsFlags.GcFlags.maxHeapSize) ||
req_blocks >= HS_INT32_MAX) // avoid overflow when
// calling allocGroup() below
{
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
bd = allocGroup(req_blocks);
dbl_link_onto(bd, &g0->large_objects);
g0->n_large_blocks += bd->blocks; // might be larger than req_blocks
g0->n_new_large_words += n;
RELEASE_SM_LOCK;
initBdescr(bd, g0, g0);
bd->flags = BF_LARGE;
bd->free = bd->start + n;
cap->total_allocated += n;
return bd->start;
}
/* small allocation (<LARGE_OBJECT_THRESHOLD) */
bd = cap->r.rCurrentAlloc;
if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
if (bd) finishedNurseryBlock(cap,bd);
// 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) {
// The nursery is empty: allocate a fresh block (we can't
// fail here).
ACQUIRE_SM_LOCK;
bd = allocBlock();
cap->r.rNursery->n_blocks++;
RELEASE_SM_LOCK;
initBdescr(bd, g0, g0);
bd->flags = 0;
// If we had to allocate a new block, then we'll GC
// pretty quickly now, because MAYBE_GC() will
// notice that CurrentNursery->link is NULL.
} else {
newNurseryBlock(bd);
// we have a block in the nursery: take it and put
// it at the *front* of the nursery list, and use it
// to allocate() from.
//
// Previously the nursery looked like this:
//
// CurrentNursery
// /
// +-+ +-+
// nursery -> ... |A| -> |B| -> ...
// +-+ +-+
//
// After doing this, it looks like this:
//
// CurrentNursery
// /
// +-+ +-+
// nursery -> |B| -> ... -> |A| -> ...
// +-+ +-+
// |
// CurrentAlloc
//
// The point is to get the block out of the way of the
// advancing CurrentNursery pointer, while keeping it
// on the nursery list so we don't lose track of it.
cap->r.rCurrentNursery->link = bd->link;
if (bd->link != NULL) {
bd->link->u.back = cap->r.rCurrentNursery;
}
}
dbl_link_onto(bd, &cap->r.rNursery->blocks);
cap->r.rCurrentAlloc = bd;
IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
}
p = bd->free;
bd->free += n;
IF_DEBUG(sanity, ASSERT(*((StgWord8*)p) == 0xaa));
return p;
}
StgPtr
allocatePinned (Capability *cap, W_ n)
{
StgPtr p;
bdescr *bd;
// If the request is for a large object, then allocate()
// will give us a pinned object anyway.
if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
p = allocate(cap, n);
Bdescr(p)->flags |= BF_PINNED;
return p;
}
TICK_ALLOC_HEAP_NOCTR(WDS(n));
CCS_ALLOC(cap->r.rCCCS,n);
if (cap->r.rCurrentTSO != NULL) {
// cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_);
ASSIGN_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit),
(PK_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit))
- n*sizeof(W_)));
}
bd = cap->pinned_object_block;
// If we don't have a block of pinned objects yet, or the current
// one isn't large enough to hold the new object, get a new one.
if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
// stash the old block on cap->pinned_object_blocks. On the
// next GC cycle these objects will be moved to
// g0->large_objects.
if (bd != NULL) {
// add it to the allocation stats when the block is full
finishedNurseryBlock(cap, bd);
dbl_link_onto(bd, &cap->pinned_object_blocks);
}
// We need to find another block. We could just allocate one,
// but that means taking a global lock and we really want to
// avoid that (benchmarks that allocate a lot of pinned
// objects scale really badly if we do this).
//
// So first, we try taking the next block from the nursery, in
// the same way as allocate(), but note that we can only take
// an *empty* block, because we're about to mark it as
// BF_PINNED | BF_LARGE.
bd = cap->r.rCurrentNursery->link;
if (bd == NULL) { // must be empty!
// The nursery is empty, or the next block is non-empty:
// allocate a fresh block (we can't fail here).
// XXX in the case when the next nursery block is
// non-empty we aren't exerting any pressure to GC soon,
// so if this case ever happens then we could in theory
// keep allocating for ever without calling the GC. We
// can't bump g0->n_new_large_words because that will be
// counted towards allocation, and we're already counting
// our pinned obects as allocation in
// collect_pinned_object_blocks in the GC.
ACQUIRE_SM_LOCK;
bd = allocBlock();
RELEASE_SM_LOCK;
initBdescr(bd, g0, g0);
} else {
newNurseryBlock(bd);
// we have a block in the nursery: steal it
cap->r.rCurrentNursery->link = bd->link;
if (bd->link != NULL) {
bd->link->u.back = cap->r.rCurrentNursery;
}
cap->r.rNursery->n_blocks -= bd->blocks;
}
cap->pinned_object_block = bd;
bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED;
// The pinned_object_block remains attached to the capability
// until it is full, even if a GC occurs. We want this
// behaviour because otherwise the unallocated portion of the
// block would be forever slop, and under certain workloads
// (allocating a few ByteStrings per GC) we accumulate a lot
// of slop.
//
// So, the pinned_object_block is initially marked
// BF_EVACUATED so the GC won't touch it. When it is full,
// we place it on the large_objects list, and at the start of
// the next GC the BF_EVACUATED flag will be cleared, and the
// block will be promoted as usual (if anything in it is
// live).
}
p = bd->free;
bd->free += n;
return p;
}
/* ---------------------------------------------------------------------------
* Getting & setting the thread allocation limit
* ------------------------------------------------------------------------ */
HsInt64 rts_getThreadAllocationCounter(StgPtr tso)
{
// NB. doesn't take into account allocation in the current nursery
// block, so it might be off by up to 4k.
return PK_Int64((W_*)&(((StgTSO *)tso)->alloc_limit));
}