-static lnat
-stepBlocks (step *stp)
-{
- lnat total_blocks;
- bdescr *bd;
-
- 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.
- */
- if (bd->blocks > BLOCKS_PER_MBLOCK) {
- total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
- * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
- }
- }
- return total_blocks;
-}
-
-void
-memInventory(void)
-{
- nat g, s, i;
- step *stp;
- bdescr *bd;
- lnat total_blocks = 0, free_blocks = 0;
-
- /* count the blocks we current have */
-
- for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
- for (i = 0; i < n_capabilities; i++) {
- for (bd = capabilities[i].mut_lists[g]; bd != NULL; bd = bd->link) {
- total_blocks += bd->blocks;
- }
- }
- for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
- total_blocks += 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);
- }
- }
-
- for (i = 0; i < n_nurseries; i++) {
- total_blocks += stepBlocks(&nurseries[i]);
- }
-#ifdef THREADED_RTS
- // We put pinned object blocks in g0s0, so better count blocks there too.
- total_blocks += stepBlocks(g0s0);
-#endif
-
- /* any blocks held by allocate() */
- for (bd = small_alloc_list; bd; bd = bd->link) {
- total_blocks += bd->blocks;
- }
-
-#ifdef PROFILING
- if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
- total_blocks += retainerStackBlocks();
- }
-#endif
-
- // count the blocks allocated by the arena allocator
- total_blocks += arenaBlocks();
-
- // count the blocks containing executable memory
- for (bd = exec_block; bd; bd = bd->link) {
- total_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);
- }
-
- ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
-}
-
-
-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 )
-{
- nat g, s;
-
- if (RtsFlags.GcFlags.generations == 1) {
- checkHeap(g0s0->blocks);
- checkChain(g0s0->large_objects);
- } else {
-
- for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
- for (s = 0; s < generations[g].n_steps; s++) {
- if (g == 0 && s == 0) { continue; }
- ASSERT(countBlocks(generations[g].steps[s].blocks)
- == generations[g].steps[s].n_blocks);
- ASSERT(countBlocks(generations[g].steps[s].large_objects)
- == generations[g].steps[s].n_large_blocks);
- checkHeap(generations[g].steps[s].blocks);
- checkChain(generations[g].steps[s].large_objects);
- if (g > 0) {
- checkMutableList(generations[g].mut_list, g);
- }
- }
- }
-
- for (s = 0; s < n_nurseries; s++) {
- ASSERT(countBlocks(nurseries[s].blocks)
- == nurseries[s].n_blocks);
- ASSERT(countBlocks(nurseries[s].large_objects)
- == nurseries[s].n_large_blocks);
- }
-
- checkFreeListSanity();
- }
-}
-
-/* Nursery sanity check */
-void
-checkNurserySanity( step *stp )
-{
- bdescr *bd, *prev;
- nat blocks = 0;
-
- prev = NULL;
- for (bd = stp->blocks; bd != NULL; bd = bd->link) {
- ASSERT(bd->u.back == prev);
- prev = bd;
- blocks += bd->blocks;
- }
- ASSERT(blocks == stp->n_blocks);
-}
-