Implement a new heap-tuning option: -H

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

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 6f15a47..0593bd7 100644 (file)
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -44,6 +44,7 @@
 #include "Evac.h"
 #include "Scav.h"
 #include "GCUtils.h"
+#include "MarkStack.h"
 #include "MarkWeak.h"
 #include "Sparks.h"
 #include "Sweep.h"
@@ -154,21 +155,12 @@ static void gcCAFs                  (void);
 #endif
 
 /* -----------------------------------------------------------------------------
-   The mark bitmap & stack.
+   The mark stack.
    -------------------------------------------------------------------------- */
 
-#define MARK_STACK_BLOCKS 4
-
-bdescr *mark_stack_bdescr;
-StgPtr *mark_stack;
-StgPtr *mark_sp;
-StgPtr *mark_splim;
-
-// Flag and pointers used for falling back to a linear scan when the
-// mark stack overflows.
-rtsBool mark_stack_overflowed;
-bdescr *oldgen_scan_bd;
-StgPtr  oldgen_scan;
+bdescr *mark_stack_top_bd; // topmost block in the mark stack
+bdescr *mark_stack_bd;     // current block in the mark stack
+StgPtr mark_sp;            // pointer to the next unallocated mark stack entry
 
 /* -----------------------------------------------------------------------------
    GarbageCollect: the main entry point to the garbage collector.
@@ -279,7 +271,7 @@ GarbageCollect (rtsBool force_major_gc,
 
 #ifdef DEBUG
   // check for memory leaks if DEBUG is on 
-  memInventory(traceClass(DEBUG_gc));
+  memInventory(DEBUG_gc);
 #endif
 
   // check stack sanity *before* GC
@@ -304,15 +296,15 @@ GarbageCollect (rtsBool force_major_gc,
   /* Allocate a mark stack if we're doing a major collection.
    */
   if (major_gc && oldest_gen->steps[0].mark) {
-      nat mark_stack_blocks;
-      mark_stack_blocks = stg_max(MARK_STACK_BLOCKS, 
-                                  oldest_gen->steps[0].n_old_blocks / 100);
-      mark_stack_bdescr = allocGroup(mark_stack_blocks);
-      mark_stack = (StgPtr *)mark_stack_bdescr->start;
-      mark_sp    = mark_stack;
-      mark_splim = mark_stack + (mark_stack_blocks * BLOCK_SIZE_W);
+      mark_stack_bd     = allocBlock();
+      mark_stack_top_bd = mark_stack_bd;
+      mark_stack_bd->link = NULL;
+      mark_stack_bd->u.back = NULL;
+      mark_sp           = mark_stack_bd->start;
   } else {
-      mark_stack_bdescr = NULL;
+      mark_stack_bd     = NULL;
+      mark_stack_top_bd = NULL;
+      mark_sp           = NULL;
   }
 
   // this is the main thread
@@ -707,8 +699,10 @@ SET_GCT(gc_threads[0]);
   pinned_object_block = NULL;
 
   // Free the mark stack.
-  if (mark_stack_bdescr != NULL) {
-      freeGroup(mark_stack_bdescr);
+  if (mark_stack_top_bd != NULL) {
+      debugTrace(DEBUG_gc, "mark stack: %d blocks",
+                 countBlocks(mark_stack_top_bd));
+      freeChain(mark_stack_top_bd);
   }
 
   // Free any bitmaps.
@@ -782,7 +776,7 @@ SET_GCT(gc_threads[0]);
 
 #ifdef DEBUG
   // check for memory leaks if DEBUG is on 
-  memInventory(traceClass(DEBUG_gc));
+  memInventory(DEBUG_gc);
 #endif
 
 #ifdef RTS_GTK_FRONTPANEL
@@ -985,8 +979,7 @@ any_work (void)
     write_barrier();
 
     // scavenge objects in compacted generation
-    if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
-       (mark_stack_bdescr != NULL && !mark_stack_empty())) {
+    if (mark_stack_bd != NULL && !mark_stack_empty()) {
        return rtsTrue;
     }
     
@@ -1027,9 +1020,10 @@ scavenge_until_all_done (void)
 {
     nat r;
        
-    debugTrace(DEBUG_gc, "GC thread %d working", gct->thread_index);
 
 loop:
+    traceEvent(&capabilities[gct->thread_index], EVENT_GC_WORK);
+
 #if defined(THREADED_RTS)
     if (n_gc_threads > 1) {
         scavenge_loop();
@@ -1043,8 +1037,9 @@ loop:
     // scavenge_loop() only exits when there's no work to do
     r = dec_running();
     
-    debugTrace(DEBUG_gc, "GC thread %d idle (%d still running)", 
-               gct->thread_index, r);
+    traceEvent(&capabilities[gct->thread_index], EVENT_GC_IDLE);
+
+    debugTrace(DEBUG_gc, "%d GC threads still running", r);
     
     while (gc_running_threads != 0) {
         // usleep(1);
@@ -1058,8 +1053,7 @@ loop:
         // scavenge_loop() to perform any pending work.
     }
     
-    // All threads are now stopped
-    debugTrace(DEBUG_gc, "GC thread %d finished.", gct->thread_index);
+    traceEvent(&capabilities[gct->thread_index], EVENT_GC_DONE);
 }
 
 #if defined(THREADED_RTS)
@@ -1134,7 +1128,7 @@ waitForGcThreads (Capability *cap USED_IF_THREADS)
                 prodCapability(&capabilities[i], cap->running_task);
             }
         }
-        for (j=0; j < 10000000; j++) {
+        for (j=0; j < 10; j++) {
             retry = rtsFalse;
             for (i=0; i < n_threads; i++) {
                 if (i == me) continue;
@@ -1145,6 +1139,7 @@ waitForGcThreads (Capability *cap USED_IF_THREADS)
                 }
             }
             if (!retry) break;
+            yieldThread();
         }
     }
 }
@@ -1553,6 +1548,10 @@ resize_generations (void)
        size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
                       RtsFlags.GcFlags.minOldGenSize);
        
+        if (RtsFlags.GcFlags.heapSizeSuggestionAuto) {
+            RtsFlags.GcFlags.heapSizeSuggestion = size;
+        }
+
        // minimum size for generation zero
        min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200,
                            RtsFlags.GcFlags.minAllocAreaSize);
@@ -1623,6 +1622,8 @@ resize_generations (void)
 static void
 resize_nursery (void)
 {
+    lnat min_nursery = RtsFlags.GcFlags.minAllocAreaSize * n_capabilities;
+
     if (RtsFlags.GcFlags.generations == 1)
     {   // Two-space collector:
        nat blocks;
@@ -1665,9 +1666,9 @@ resize_nursery (void)
        else
        {
            blocks *= RtsFlags.GcFlags.oldGenFactor;
-           if (blocks < RtsFlags.GcFlags.minAllocAreaSize)
+           if (blocks < min_nursery)
            {
-               blocks = RtsFlags.GcFlags.minAllocAreaSize;
+               blocks = min_nursery;
            }
        }
        resizeNurseries(blocks);
@@ -1714,8 +1715,8 @@ resize_nursery (void)
                (((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
                (100 + (long)g0s0_pcnt_kept);
            
-           if (blocks < (long)RtsFlags.GcFlags.minAllocAreaSize) {
-               blocks = RtsFlags.GcFlags.minAllocAreaSize;
+           if (blocks < (long)min_nursery) {
+               blocks = min_nursery;
            }
            
            resizeNurseries((nat)blocks);