-StgPtr
-allocateInGen (generation *g, lnat n)
-{
- step *stp;
- bdescr *bd;
- StgPtr ret;
-
- ACQUIRE_SM_LOCK;
-
- TICK_ALLOC_HEAP_NOCTR(n);
- CCS_ALLOC(CCCS,n);
-
- stp = &g->steps[0];
-
- if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_))
- {
- lnat req_blocks = (lnat)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) {
- 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);
- }
-
- bd = allocGroup(req_blocks);
- dbl_link_onto(bd, &stp->large_objects);
- stp->n_large_blocks += bd->blocks; // might be larger than req_blocks
- alloc_blocks += bd->blocks;
- initBdescr(bd, stp);
- bd->flags = BF_LARGE;
- bd->free = bd->start + n;
- ret = bd->start;
- }
- else
- {
- // small allocation (<LARGE_OBJECT_THRESHOLD) */
- bd = stp->blocks;
- if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
- bd = allocBlock();
- initBdescr(bd, stp);
- bd->flags = 0;
- bd->link = stp->blocks;
- stp->blocks = bd;
- stp->n_blocks++;
- alloc_blocks++;
- }
- ret = bd->free;
- bd->free += n;
- }
-
- RELEASE_SM_LOCK;
-
- return ret;
-}
-
-StgPtr
-allocate (lnat n)
-{
- return allocateInGen(g0,n);
-}
-
-lnat
-allocatedBytes( void )
-{
- lnat allocated;
-
- allocated = alloc_blocks * BLOCK_SIZE_W;
- if (pinned_object_block != NULL) {
- allocated -= (pinned_object_block->start + BLOCK_SIZE_W) -
- pinned_object_block->free;
- }
-
- return allocated;
-}
-
-// split N blocks off the front of the given bdescr, returning the
-// new block group. We treat the remainder as if it
-// had been freshly allocated in generation 0.