static StgCompactNFDataBlock * compactAllocateBlockInternal(Capability *cap, StgWord aligned_size, StgCompactNFDataBlock *first, AllocateOp operation) { StgCompactNFDataBlock *self; bdescr *block, *head; uint32_t n_blocks; generation *g; n_blocks = aligned_size / BLOCK_SIZE; // Attempting to allocate an object larger than maxHeapSize // should definitely be disallowed. (bug #1791) if ((RtsFlags.GcFlags.maxHeapSize > 0 && n_blocks >= RtsFlags.GcFlags.maxHeapSize) || n_blocks >= HS_INT32_MAX) // avoid overflow when // calling allocGroup() below { reportHeapOverflow(); // reportHeapOverflow() 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); } // It is imperative that first is the first block in the compact // (or NULL if the compact does not exist yet) // because the evacuate code does not update the generation of // blocks other than the first (so we would get the statistics // wrong and crash in Sanity) if (first != NULL) { block = Bdescr((P_)first); g = block->gen; } else { g = g0; } ACQUIRE_SM_LOCK; block = allocGroup(n_blocks); switch (operation) { case ALLOCATE_NEW: ASSERT(first == NULL); ASSERT(g == g0); dbl_link_onto(block, &g0->compact_objects); g->n_compact_blocks += block->blocks; g->n_new_large_words += aligned_size / sizeof(StgWord); break; case ALLOCATE_IMPORT_NEW: dbl_link_onto(block, &g0->compact_blocks_in_import); /* fallthrough */ case ALLOCATE_IMPORT_APPEND: ASSERT(first == NULL); ASSERT(g == g0); g->n_compact_blocks_in_import += block->blocks; g->n_new_large_words += aligned_size / sizeof(StgWord); break; case ALLOCATE_APPEND: g->n_compact_blocks += block->blocks; if (g == g0) g->n_new_large_words += aligned_size / sizeof(StgWord); break; default: #if defined(DEBUG) ASSERT(!"code should not be reached"); #else RTS_UNREACHABLE; #endif } RELEASE_SM_LOCK; cap->total_allocated += aligned_size / sizeof(StgWord); self = (StgCompactNFDataBlock*) block->start; self->self = self; self->next = NULL; head = block; initBdescr(head, g, g); head->flags = BF_COMPACT; for (block = head + 1, n_blocks --; n_blocks > 0; block++, n_blocks--) { block->link = head; block->blocks = 0; block->flags = BF_COMPACT; } return self; }
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 { reportHeapOverflow(); // 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 = allocGroupOnNode(cap->node,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 = allocBlockOnNode(cap->node); 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; }