X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FStorage.c;h=c02adf9dcc3cbee9c355b3dd9872e8be30893923;hb=c09b0ab58d435213b7c9a034728a88cf36b62e81;hp=a657ce8d3e79e1fbaf2f92d8eb7c82efa5bdd4d9;hpb=ab0e778ccfde61aed4c22679b24d175fc6cc9bf3;p=ghc-hetmet.git diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index a657ce8..c02adf9 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1,9 +1,14 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 1998-2004 + * (c) The GHC Team, 1998-2006 * * Storage manager front end * + * Documentation on the architecture of the Storage Manager can be + * found in the online commentary: + * + * http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage + * * ---------------------------------------------------------------------------*/ #include "PosixSource.h" @@ -361,15 +366,6 @@ newCAF(StgClosure* caf) } RELEASE_SM_LOCK; - -#ifdef PAR - /* If we are PAR or DIST then we never forget a CAF */ - { globalAddr *newGA; - //debugBelch("<##> Globalising CAF %08x %s",caf,info_type(caf)); - newGA=makeGlobal(caf,rtsTrue); /*given full weight*/ - ASSERT(newGA); - } -#endif /* PAR */ } // An alternate version of newCaf which is used for dynamically loaded @@ -459,7 +455,6 @@ allocNurseries( void ) nurseries[i].n_blocks = RtsFlags.GcFlags.minAllocAreaSize; nurseries[i].old_blocks = NULL; nurseries[i].n_old_blocks = 0; - /* hp, hpLim, hp_bd, to_space etc. aren't used in the nursery */ } assignNurseriesToCapabilities(); } @@ -768,6 +763,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; @@ -921,9 +917,7 @@ calcLive(void) step *stp; if (RtsFlags.GcFlags.generations == 1) { - live = (g0s0->n_blocks - 1) * BLOCK_SIZE_W + - ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_); - return live; + return (g0s0->n_large_blocks + g0s0->n_blocks) * BLOCK_SIZE_W; } for (g = 0; g < RtsFlags.GcFlags.generations; g++) { @@ -935,14 +929,7 @@ calcLive(void) continue; } stp = &generations[g].steps[s]; - live += (stp->n_large_blocks + stp->n_blocks - 1) * BLOCK_SIZE_W; - if (stp->hp_bd != NULL) { - live += ((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start) - / sizeof(W_); - } - if (stp->scavd_hp != NULL) { - live -= (P_)(BLOCK_ROUND_UP(stp->scavd_hp)) - stp->scavd_hp; - } + live += (stp->n_large_blocks + stp->n_blocks) * BLOCK_SIZE_W; } } return live; @@ -1110,64 +1097,87 @@ memInventory(void) nat g, s, i; step *stp; bdescr *bd; - lnat total_blocks = 0, free_blocks = 0; + lnat gen_blocks[RtsFlags.GcFlags.generations]; + lnat nursery_blocks, allocate_blocks, retainer_blocks, + arena_blocks, exec_blocks; + lnat live_blocks = 0, free_blocks = 0; - /* count the blocks we current have */ + // count the blocks we current have 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) { - total_blocks += bd->blocks; + gen_blocks[g] += bd->blocks; } } for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { - total_blocks += bd->blocks; + gen_blocks[g] += bd->blocks; } for (s = 0; s < generations[g].n_steps; s++) { if (g==0 && s==0) continue; stp = &generations[g].steps[s]; - total_blocks += stepBlocks(stp); + gen_blocks[g] += stepBlocks(stp); } } + nursery_blocks = 0; for (i = 0; i < n_nurseries; i++) { - total_blocks += stepBlocks(&nurseries[i]); + nursery_blocks += stepBlocks(&nurseries[i]); } #ifdef THREADED_RTS // We put pinned object blocks in g0s0, so better count blocks there too. - total_blocks += stepBlocks(g0s0); + gen_blocks[0] += stepBlocks(g0s0); #endif /* any blocks held by allocate() */ + allocate_blocks = 0; for (bd = small_alloc_list; bd; bd = bd->link) { - total_blocks += bd->blocks; + allocate_blocks += bd->blocks; } + retainer_blocks = 0; #ifdef PROFILING if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) { - total_blocks += retainerStackBlocks(); + retainer_blocks = retainerStackBlocks(); } #endif // count the blocks allocated by the arena allocator - total_blocks += arenaBlocks(); + arena_blocks = arenaBlocks(); // count the blocks containing executable memory + exec_blocks = 0; for (bd = exec_block; bd; bd = bd->link) { - total_blocks += bd->blocks; + exec_blocks += bd->blocks; } /* count the blocks on the free list */ free_blocks = countFreeList(); - if (total_blocks + free_blocks != mblocks_allocated * - BLOCKS_PER_MBLOCK) { - debugBelch("Blocks: %ld live + %ld free = %ld total (%ld around)\n", - total_blocks, free_blocks, total_blocks + free_blocks, - mblocks_allocated * BLOCKS_PER_MBLOCK); + live_blocks = 0; + for (g = 0; g < RtsFlags.GcFlags.generations; g++) { + live_blocks += gen_blocks[g]; } + live_blocks += nursery_blocks + allocate_blocks + + retainer_blocks + arena_blocks + exec_blocks; - ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK); + if (live_blocks + free_blocks != mblocks_allocated * BLOCKS_PER_MBLOCK) + { + debugBelch("Memory leak detected\n"); + for (g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch(" gen %d blocks : %4lu\n", g, gen_blocks[g]); + } + debugBelch(" nursery : %4lu\n", nursery_blocks); + debugBelch(" allocate() : %4lu\n", allocate_blocks); + debugBelch(" retainer : %4lu\n", retainer_blocks); + debugBelch(" arena blocks : %4lu\n", arena_blocks); + 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); + ASSERT(0); + } }