when a memory leak is detected, report which blocks are unreachable

[ghc-hetmet.git] / rts / sm / Storage.c

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index a41894a..a6134c6 100644 (file)
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -124,7 +124,7 @@ initStorage( void )
    * doing something reasonable.
    */
   /* We use the NOT_NULL variant or gcc warns that the test is always true */
-  ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL(&stg_BLACKHOLE_info));
+  ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLACKHOLE_info));
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
   ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
   
@@ -1270,6 +1270,51 @@ stepBlocks (step *stp)
            countAllocdBlocks(stp->large_objects);
 }
 
+// If memInventory() calculates that we have a memory leak, this
+// function will try to find the block(s) that are leaking by marking
+// all the ones that we know about, and search through memory to find
+// blocks that are not marked.  In the debugger this can help to give
+// us a clue about what kind of block leaked.  In the future we might
+// annotate blocks with their allocation site to give more helpful
+// info.
+static void
+findMemoryLeak (void)
+{
+  nat g, s, i;
+  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+      for (i = 0; i < n_capabilities; i++) {
+         markBlocks(capabilities[i].mut_lists[g]);
+      }
+      markBlocks(generations[g].mut_list);
+      for (s = 0; s < generations[g].n_steps; s++) {
+         markBlocks(generations[g].steps[s].blocks);
+         markBlocks(generations[g].steps[s].large_objects);
+      }
+  }
+
+  for (i = 0; i < n_nurseries; i++) {
+      markBlocks(nurseries[i].blocks);
+      markBlocks(nurseries[i].large_objects);
+  }
+
+#ifdef PROFILING
+  // TODO:
+  // if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
+  //    markRetainerBlocks();
+  // }
+#endif
+
+  // count the blocks allocated by the arena allocator
+  // TODO:
+  // markArenaBlocks();
+
+  // count the blocks containing executable memory
+  markBlocks(exec_block);
+
+  reportUnmarkedBlocks();
+}
+
+
 void
 memInventory (rtsBool show)
 {
@@ -1327,8 +1372,6 @@ memInventory (rtsBool show)
 
   leak = live_blocks + free_blocks != mblocks_allocated * BLOCKS_PER_MBLOCK;
 
-  ASSERT(n_alloc_blocks == live_blocks);
-
   if (show || leak)
   {
       if (leak) { 
@@ -1357,6 +1400,13 @@ memInventory (rtsBool show)
                      mblocks_allocated * BLOCKS_PER_MBLOCK, mblocks_allocated);
       }
   }
+
+  if (leak) {
+      debugBelch("\n");
+      findMemoryLeak();
+  }
+  ASSERT(n_alloc_blocks == live_blocks);
+  ASSERT(!leak);
 }
 
 
@@ -1395,6 +1445,14 @@ checkSanity( void )
            
        checkFreeListSanity();
     }
+
+#if defined(THREADED_RTS)
+    // check the stacks too in threaded mode, because we don't do a
+    // full heap sanity check in this case (see checkHeap())
+    checkGlobalTSOList(rtsTrue);
+#else
+    checkGlobalTSOList(rtsFalse);
+#endif
 }
 
 /* Nursery sanity check */