[commit: ghc] ghc-7.2: Move the call to heapCensus() into GarbageCollect(), just before (96940b4)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.2

http://hackage.haskell.org/trac/ghc/changeset/96940b4838b5ff7ebd4f1e062a47d2c7eb9f5419

>---------------------------------------------------------------

commit 96940b4838b5ff7ebd4f1e062a47d2c7eb9f5419
Author: Ian Lynagh <igloo at earth.li>
Date:   Wed Jul 20 21:35:49 2011 +0100

    Move the call to heapCensus() into GarbageCollect(), just before
    calling resurrectThreads() (fixes #5314).
    
    This avoids a lot of problems, because resurrectThreads() may
    overwrite some closures in the heap, leaving slop behind.  The bug in
    instances, this fix avoids them all in one go.
    
    Conflicts:
    
    	rts/Schedule.c

>---------------------------------------------------------------

 rts/Schedule.c |    9 ++++-----
 rts/sm/GC.c    |   10 ++++++++++
 rts/sm/GC.h    |    4 +++-
 3 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 50e0663..b660c33 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1434,9 +1434,9 @@ delete_threads_and_gc:
     // reset waiting_for_gc *before* GC, so that when the GC threads
     // emerge they don't immediately re-enter the GC.
     waiting_for_gc = 0;
-    GarbageCollect(force_major || heap_census, gc_type, cap);
+    GarbageCollect(force_major || heap_census, heap_census, gc_type, cap);
 #else
-    GarbageCollect(force_major || heap_census, 0, cap);
+    GarbageCollect(force_major || heap_census, heap_census, 0, cap);
 #endif
     traceEventGcEnd(cap);
 
@@ -1457,10 +1457,9 @@ delete_threads_and_gc:
         recent_activity = ACTIVITY_YES;
     }
 
+    // The heap census itself is done during GarbageCollect().
     if (heap_census) {
-        debugTrace(DEBUG_sched, "performing heap census");
-        heapCensus();
-	performHeapProfile = rtsFalse;
+        performHeapProfile = rtsFalse;
     }
 
 #if defined(THREADED_RTS)
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 9f69a4c..396992c 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -171,6 +171,7 @@ StgPtr mark_sp;            // pointer to the next unallocated mark stack entry
 
 void
 GarbageCollect (rtsBool force_major_gc, 
+                rtsBool do_heap_census,
                 nat gc_type USED_IF_THREADS,
                 Capability *cap)
 {
@@ -661,6 +662,15 @@ GarbageCollect (rtsBool force_major_gc,
   // fill slop.
   IF_DEBUG(sanity, checkSanity(rtsTrue /* after GC */, major_gc));
 
+  // If a heap census is due, we need to do it before
+  // resurrectThreads(), for the same reason as checkSanity above:
+  // resurrectThreads() will overwrite some closures and leave slop
+  // behind.
+  if (do_heap_census) {
+      debugTrace(DEBUG_sched, "performing heap census");
+      heapCensus();
+  }
+
   // send exceptions to any threads which were about to die
   RELEASE_SM_LOCK;
   resurrectThreads(resurrected_threads);
diff --git a/rts/sm/GC.h b/rts/sm/GC.h
index 38fc87c..eb18023 100644
--- a/rts/sm/GC.h
+++ b/rts/sm/GC.h
@@ -16,7 +16,9 @@
 
 #include "BeginPrivate.h"
 
-void GarbageCollect(rtsBool force_major_gc, nat gc_type, Capability *cap);
+void GarbageCollect (rtsBool force_major_gc,
+                     rtsBool do_heap_census,
+                     nat gc_type, Capability *cap);
 
 typedef void (*evac_fn)(void *user, StgClosure **root);