X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FStorage.c;h=f9e32f288a93989b72afc05834726999be5e301e;hb=0d88de0b114a391712bc117d42928b49fba4d66a;hp=b7028d5b594886167db3c18e42ac78986710f7d0;hpb=0fe7bd77c882fd53f0ef6a3ce1df050445bc8db1;p=ghc-hetmet.git diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index b7028d5..f9e32f2 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -115,6 +115,8 @@ initStorage( void ) return; } + initMBlocks(); + /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be * doing something reasonable. */ @@ -287,6 +289,7 @@ freeStorage (void) #if defined(THREADED_RTS) closeMutex(&sm_mutex); closeMutex(&atomic_modify_mutvar_mutex); + stgFree(nurseries); #endif } @@ -578,7 +581,7 @@ allocate( nat n ) nat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; bd = allocGroup(req_blocks); dbl_link_onto(bd, &g0s0->large_objects); - g0s0->n_large_blocks += req_blocks; + g0s0->n_large_blocks += bd->blocks; // might be larger than req_blocks bd->gen_no = 0; bd->step = g0s0; bd->flags = BF_LARGE; @@ -662,7 +665,7 @@ allocateLocal (Capability *cap, nat n) ACQUIRE_SM_LOCK; bd = allocGroup(req_blocks); dbl_link_onto(bd, &g0s0->large_objects); - g0s0->n_large_blocks += req_blocks; + g0s0->n_large_blocks += bd->blocks; // might be larger than req_blocks bd->gen_no = 0; bd->step = g0s0; bd->flags = BF_LARGE; @@ -763,6 +766,7 @@ allocatePinned( nat n ) if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) { pinned_object_block = bd = allocBlock(); dbl_link_onto(bd, &g0s0->large_objects); + g0s0->n_large_blocks++; bd->gen_no = 0; bd->step = g0s0; bd->flags = BF_PINNED | BF_LARGE; @@ -978,6 +982,11 @@ calcNeeded(void) in the page, and when the page is emptied (all objects on the page are free) we free the page again, not forgetting to make it non-executable. + + TODO: The inability to handle objects bigger than BLOCK_SIZE_W means that + the linker cannot use allocateExec for loading object code files + on Windows. Once allocateExec can handle larger objects, the linker + should be modified to use allocateExec instead of VirtualAlloc. ------------------------------------------------------------------------- */ static bdescr *exec_block; @@ -1039,20 +1048,17 @@ void freeExec (void *addr) bd->gen_no -= *(StgPtr)p; *(StgPtr)p = 0; - // Free the block if it is empty, but not if it is the block at - // the head of the queue. - if (bd->gen_no == 0 && bd != exec_block) { - debugTrace(DEBUG_gc, "free exec block %p", bd->start); - if (bd->u.back) { - bd->u.back->link = bd->link; - } else { - exec_block = bd->link; - } - if (bd->link) { - bd->link->u.back = bd->u.back; - } - setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse); - freeGroup(bd); + if (bd->gen_no == 0) { + // Free the block if it is empty, but not if it is the block at + // the head of the queue. + if (bd != exec_block) { + debugTrace(DEBUG_gc, "free exec block %p", bd->start); + dbl_link_remove(bd, &exec_block); + setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse); + freeGroup(bd); + } else { + bd->free = bd->start; + } } RELEASE_SM_LOCK @@ -1068,26 +1074,43 @@ void freeExec (void *addr) #ifdef DEBUG -static lnat -stepBlocks (step *stp) +nat +countBlocks(bdescr *bd) { - lnat total_blocks; - bdescr *bd; + nat n; + for (n=0; bd != NULL; bd=bd->link) { + n += bd->blocks; + } + return n; +} - total_blocks = stp->n_blocks; - total_blocks += stp->n_old_blocks; - for (bd = stp->large_objects; bd; bd = bd->link) { - total_blocks += bd->blocks; - /* hack for megablock groups: they have an extra block or two in - the second and subsequent megablocks where the block - descriptors would normally go. - */ +// (*1) Just like countBlocks, except that we adjust the count for a +// megablock group so that it doesn't include the extra few blocks +// that would be taken up by block descriptors in the second and +// subsequent megablock. This is so we can tally the count with the +// number of blocks allocated in the system, for memInventory(). +static nat +countAllocdBlocks(bdescr *bd) +{ + nat n; + for (n=0; bd != NULL; bd=bd->link) { + n += bd->blocks; + // hack for megablock groups: see (*1) above if (bd->blocks > BLOCKS_PER_MBLOCK) { - total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK) + n -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK) * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE)); } } - return total_blocks; + return n; +} + +static lnat +stepBlocks (step *stp) +{ + ASSERT(countBlocks(stp->blocks) == stp->n_blocks); + ASSERT(countBlocks(stp->large_objects) == stp->n_large_blocks); + return stp->n_blocks + stp->n_old_blocks + + countAllocdBlocks(stp->large_objects); } void @@ -1095,7 +1118,6 @@ memInventory(void) { nat g, s, i; step *stp; - bdescr *bd; lnat gen_blocks[RtsFlags.GcFlags.generations]; lnat nursery_blocks, allocate_blocks, retainer_blocks, arena_blocks, exec_blocks; @@ -1106,15 +1128,15 @@ memInventory(void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { gen_blocks[g] = 0; for (i = 0; i < n_capabilities; i++) { - for (bd = capabilities[i].mut_lists[g]; bd != NULL; bd = bd->link) { - gen_blocks[g] += bd->blocks; - } + gen_blocks[g] += countBlocks(capabilities[i].mut_lists[g]); } - for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { - gen_blocks[g] += bd->blocks; - } + gen_blocks[g] += countAllocdBlocks(generations[g].mut_list); for (s = 0; s < generations[g].n_steps; s++) { +#if !defined(THREADED_RTS) + // We put pinned object blocks in g0s0, so better count + // blocks there too. if (g==0 && s==0) continue; +#endif stp = &generations[g].steps[s]; gen_blocks[g] += stepBlocks(stp); } @@ -1124,16 +1146,9 @@ memInventory(void) for (i = 0; i < n_nurseries; i++) { nursery_blocks += stepBlocks(&nurseries[i]); } -#ifdef THREADED_RTS - // We put pinned object blocks in g0s0, so better count blocks there too. - gen_blocks[0] += stepBlocks(g0s0); -#endif /* any blocks held by allocate() */ - allocate_blocks = 0; - for (bd = small_alloc_list; bd; bd = bd->link) { - allocate_blocks += bd->blocks; - } + allocate_blocks = countAllocdBlocks(small_alloc_list); retainer_blocks = 0; #ifdef PROFILING @@ -1146,10 +1161,7 @@ memInventory(void) arena_blocks = arenaBlocks(); // count the blocks containing executable memory - exec_blocks = 0; - for (bd = exec_block; bd; bd = bd->link) { - exec_blocks = bd->blocks; - } + exec_blocks = countAllocdBlocks(exec_block); /* count the blocks on the free list */ free_blocks = countFreeList(); @@ -1174,22 +1186,12 @@ memInventory(void) debugBelch(" exec : %4lu\n", exec_blocks); debugBelch(" free : %4lu\n", free_blocks); debugBelch(" total : %4lu\n\n", live_blocks + free_blocks); - debugBelch(" in system : %4lu\n", mblocks_allocated + BLOCKS_PER_MBLOCK); + debugBelch(" in system : %4lu\n", mblocks_allocated * BLOCKS_PER_MBLOCK); ASSERT(0); } } -nat -countBlocks(bdescr *bd) -{ - nat n; - for (n=0; bd != NULL; bd=bd->link) { - n += bd->blocks; - } - return n; -} - /* Full heap sanity check. */ void checkSanity( void )