Refactoring of the GC in preparation for parallel GC
[ghc-hetmet.git] / rts / sm / GC.c
index f686c6d..17bc204 100644 (file)
@@ -39,6 +39,7 @@
 #include "Trace.h"
 #include "RetainerProfile.h"
 #include "RaiseAsync.h"
+#include "Sparks.h"
 
 #include "GC.h"
 #include "Compact.h"
 
 #include <string.h> // for memset()
 
+/* -----------------------------------------------------------------------------
+   Global variables
+   -------------------------------------------------------------------------- */
+
 /* STATIC OBJECT LIST.
  *
  * During GC:
@@ -85,6 +90,9 @@
  */
 StgClosure* static_objects;      // live static objects
 StgClosure* scavenged_static_objects;   // static objects scavenged so far
+#ifdef THREADED_RTS
+SpinLock static_objects_sync;
+#endif
 
 /* N is the oldest generation being collected, where the generations
  * are numbered starting at 0.  A major GC (indicated by the major_gc
@@ -94,25 +102,8 @@ StgClosure* scavenged_static_objects;   // static objects scavenged so far
 nat N;
 rtsBool major_gc;
 
-/* Youngest generation that objects should be evacuated to in
- * evacuate().  (Logically an argument to evacuate, but it's static
- * a lot of the time so we optimise it into a global variable).
- */
-nat evac_gen;
-
-/* Whether to do eager promotion or not.
- */
-rtsBool eager_promotion;
-
-/* Flag indicating failure to evacuate an object to the desired
- * generation.
- */
-rtsBool failed_to_evac;
-
 /* Data used for allocation area sizing.
  */
-lnat new_blocks;                // blocks allocated during this GC 
-lnat new_scavd_blocks;  // ditto, but depth-first blocks
 static lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC 
 
 /* Mut-list stats */
@@ -123,20 +114,36 @@ nat mutlist_MUTVARS,
     mutlist_OTHERS;
 #endif
 
+/* Thread-local data for each GC thread
+ */
+gc_thread *gc_threads = NULL;
+gc_thread *gct = NULL;  // this thread's gct TODO: make thread-local
+
+// For stats:
+long copied;        // *words* copied & scavenged during this GC
+long scavd_copied;  // *words* copied only during this GC
+
 /* -----------------------------------------------------------------------------
    Static function declarations
    -------------------------------------------------------------------------- */
 
-static void         mark_root               ( StgClosure **root );
-
-static void         zero_static_object_list ( StgClosure* first_static );
+static void mark_root               (StgClosure **root);
+static void zero_static_object_list (StgClosure* first_static);
+static void initialise_N            (rtsBool force_major_gc);
+static void alloc_gc_threads        (void);
+static void init_collected_gen      (nat g, nat threads);
+static void init_uncollected_gen    (nat g, nat threads);
+static void init_gc_thread          (gc_thread *t);
+static void update_task_list        (void);
+static void resize_generations      (void);
+static void resize_nursery          (void);
 
 #if 0 && defined(DEBUG)
-static void         gcCAFs                  ( void );
+static void gcCAFs                  (void);
 #endif
 
 /* -----------------------------------------------------------------------------
-   inline functions etc. for dealing with the mark bitmap & stack.
+   The mark bitmap & stack.
    -------------------------------------------------------------------------- */
 
 #define MARK_STACK_BLOCKS 4
@@ -153,37 +160,9 @@ bdescr *oldgen_scan_bd;
 StgPtr  oldgen_scan;
 
 /* -----------------------------------------------------------------------------
-   GarbageCollect
-
-   Rough outline of the algorithm: for garbage collecting generation N
-   (and all younger generations):
-
-     - follow all pointers in the root set.  the root set includes all 
-       mutable objects in all generations (mutable_list).
-
-     - for each pointer, evacuate the object it points to into either
-
-       + to-space of the step given by step->to, which is the next
-         highest step in this generation or the first step in the next
-         generation if this is the last step.
-
-       + to-space of generations[evac_gen]->steps[0], if evac_gen != 0.
-         When we evacuate an object we attempt to evacuate
-         everything it points to into the same generation - this is
-         achieved by setting evac_gen to the desired generation.  If
-         we can't do this, then an entry in the mut list has to
-         be made for the cross-generation pointer.
-
-       + if the object is already in a generation > N, then leave
-         it alone.
-
-     - repeatedly scavenge to-space from each step in each generation
-       being collected until no more objects can be evacuated.
-      
-     - free from-space in each step, and set from-space = to-space.
+   GarbageCollect: the main entry point to the garbage collector.
 
    Locks held: all capabilities are held throughout GarbageCollect().
-
    -------------------------------------------------------------------------- */
 
 void
@@ -191,9 +170,11 @@ GarbageCollect ( rtsBool force_major_gc )
 {
   bdescr *bd;
   step *stp;
-  lnat live, allocated, copied = 0, scavd_copied = 0;
+  lnat live, allocated;
   lnat oldgen_saved_blocks = 0;
-  nat g, s, i;
+  nat n_threads; // number of threads participating in GC
+
+  nat g, s, t;
 
 #ifdef PROFILING
   CostCentreStack *prev_CCS;
@@ -210,7 +191,7 @@ GarbageCollect ( rtsBool force_major_gc )
   }
 #endif
 
-  // tell the STM to discard any cached closures its hoping to re-use
+  // tell the STM to discard any cached closures it's hoping to re-use
   stmPreGCHook();
 
   // tell the stats department that we've started a GC 
@@ -240,20 +221,24 @@ GarbageCollect ( rtsBool force_major_gc )
 
   /* Figure out which generation to collect
    */
-  if (force_major_gc) {
-    N = RtsFlags.GcFlags.generations - 1;
-    major_gc = rtsTrue;
+  initialise_N(force_major_gc);
+
+  /* Allocate + initialise the gc_thread structures.
+   */
+  alloc_gc_threads();
+
+  /* How many threads will be participating in this GC?
+   * We don't try to parallelise minor GC.
+   */
+#if defined(THREADED_RTS)
+  if (N == 0) {
+      n_threads = 1;
   } else {
-    N = 0;
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-      if (generations[g].steps[0].n_blocks +
-         generations[g].steps[0].n_large_blocks
-         >= generations[g].max_blocks) {
-        N = g;
-      }
-    }
-    major_gc = (N == RtsFlags.GcFlags.generations-1);
+      n_threads = RtsFlags.ParFlags.gcThreads;
   }
+#else
+  n_threads = 1;
+#endif
 
 #ifdef RTS_GTK_FRONTPANEL
   if (RtsFlags.GcFlags.frontpanel) {
@@ -268,143 +253,18 @@ GarbageCollect ( rtsBool force_major_gc )
    */
   static_objects = END_OF_STATIC_LIST;
   scavenged_static_objects = END_OF_STATIC_LIST;
+#ifdef THREADED_RTS
+  initSpinLock(&static_objects_sync);
+#endif
 
-  /* Keep a count of how many new blocks we allocated during this GC
-   * (used for resizing the allocation area, later).
-   */
-  new_blocks = 0;
-  new_scavd_blocks = 0;
-
-  // Initialise to-space in all the generations/steps that we're
-  // collecting.
-  //
+  // Initialise all the generations/steps that we're collecting.
   for (g = 0; g <= N; g++) {
-
-    // throw away the mutable list.  Invariant: the mutable list
-    // always has at least one block; this means we can avoid a check for
-    // NULL in recordMutable().
-    if (g != 0) {
-       freeChain(generations[g].mut_list);
-       generations[g].mut_list = allocBlock();
-       for (i = 0; i < n_capabilities; i++) {
-           freeChain(capabilities[i].mut_lists[g]);
-           capabilities[i].mut_lists[g] = allocBlock();
-       }
-    }
-
-    for (s = 0; s < generations[g].n_steps; s++) {
-
-      // generation 0, step 0 doesn't need to-space 
-      if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { 
-       continue; 
-      }
-
-      stp = &generations[g].steps[s];
-      ASSERT(stp->gen_no == g);
-
-      // start a new to-space for this step.
-      stp->old_blocks   = stp->blocks;
-      stp->n_old_blocks = stp->n_blocks;
-
-      // allocate the first to-space block; extra blocks will be
-      // chained on as necessary.
-      stp->hp_bd     = NULL;
-      bd = gc_alloc_block(stp);
-      stp->blocks      = bd;
-      stp->n_blocks    = 1;
-      stp->scan        = bd->start;
-      stp->scan_bd     = bd;
-
-      // allocate a block for "already scavenged" objects.  This goes
-      // on the front of the stp->blocks list, so it won't be
-      // traversed by the scavenging sweep.
-      gc_alloc_scavd_block(stp);
-
-      // initialise the large object queues.
-      stp->new_large_objects = NULL;
-      stp->scavenged_large_objects = NULL;
-      stp->n_scavenged_large_blocks = 0;
-
-      // mark the large objects as not evacuated yet 
-      for (bd = stp->large_objects; bd; bd = bd->link) {
-       bd->flags &= ~BF_EVACUATED;
-      }
-
-      // for a compacted step, we need to allocate the bitmap
-      if (stp->is_compacted) {
-         nat bitmap_size; // in bytes
-         bdescr *bitmap_bdescr;
-         StgWord *bitmap;
-
-         bitmap_size = stp->n_old_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
-
-         if (bitmap_size > 0) {
-             bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) 
-                                        / BLOCK_SIZE);
-             stp->bitmap = bitmap_bdescr;
-             bitmap = bitmap_bdescr->start;
-             
-             debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
-                        bitmap_size, bitmap);
-             
-             // don't forget to fill it with zeros!
-             memset(bitmap, 0, bitmap_size);
-             
-             // For each block in this step, point to its bitmap from the
-             // block descriptor.
-             for (bd=stp->old_blocks; bd != NULL; bd = bd->link) {
-                 bd->u.bitmap = bitmap;
-                 bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
-
-                 // Also at this point we set the BF_COMPACTED flag
-                 // for this block.  The invariant is that
-                 // BF_COMPACTED is always unset, except during GC
-                 // when it is set on those blocks which will be
-                 // compacted.
-                 bd->flags |= BF_COMPACTED;
-             }
-         }
-      }
-    }
+      init_collected_gen(g,n_threads);
   }
-
-  /* make sure the older generations have at least one block to
-   * allocate into (this makes things easier for copy(), see below).
-   */
+  
+  // Initialise all the generations/steps that we're *not* collecting.
   for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
-    for (s = 0; s < generations[g].n_steps; s++) {
-      stp = &generations[g].steps[s];
-      if (stp->hp_bd == NULL) {
-         ASSERT(stp->blocks == NULL);
-         bd = gc_alloc_block(stp);
-         stp->blocks = bd;
-         stp->n_blocks = 1;
-      }
-      if (stp->scavd_hp == NULL) {
-         gc_alloc_scavd_block(stp);
-         stp->n_blocks++;
-      }
-      /* Set the scan pointer for older generations: remember we
-       * still have to scavenge objects that have been promoted. */
-      stp->scan = stp->hp;
-      stp->scan_bd = stp->hp_bd;
-      stp->new_large_objects = NULL;
-      stp->scavenged_large_objects = NULL;
-      stp->n_scavenged_large_blocks = 0;
-    }
-
-    /* Move the private mutable lists from each capability onto the
-     * main mutable list for the generation.
-     */
-    for (i = 0; i < n_capabilities; i++) {
-       for (bd = capabilities[i].mut_lists[g]; 
-            bd->link != NULL; bd = bd->link) {
-           /* nothing */
-       }
-       bd->link = generations[g].mut_list;
-       generations[g].mut_list = capabilities[i].mut_lists[g];
-       capabilities[i].mut_lists[g] = allocBlock();
-    }
+      init_uncollected_gen(g,n_threads);
   }
 
   /* Allocate a mark stack if we're doing a major collection.
@@ -418,55 +278,51 @@ GarbageCollect ( rtsBool force_major_gc )
       mark_stack_bdescr = NULL;
   }
 
-  eager_promotion = rtsTrue; // for now
+  // Initialise all our gc_thread structures
+  for (t = 0; t < n_threads; t++) {
+      init_gc_thread(&gc_threads[t]);
+  }
+
+  // Initialise stats
+  copied = 0;
+  scavd_copied = 0;
+
+  // start threads etc.
+  // For now, we just have one thread, and set gct to gc_threads[0]
+  gct = &gc_threads[0];
 
   /* -----------------------------------------------------------------------
    * follow all the roots that we know about:
    *   - mutable lists from each generation > N
    * we want to *scavenge* these roots, not evacuate them: they're not
    * going to move in this GC.
-   * Also: do them in reverse generation order.  This is because we
-   * often want to promote objects that are pointed to by older
-   * generations early, so we don't have to repeatedly copy them.
-   * Doing the generations in reverse order ensures that we don't end
-   * up in the situation where we want to evac an object to gen 3 and
-   * it has already been evaced to gen 2.
+   * Also do them in reverse generation order, for the usual reason:
+   * namely to reduce the likelihood of spurious old->new pointers.
    */
   { 
-    int st;
     for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
       generations[g].saved_mut_list = generations[g].mut_list;
       generations[g].mut_list = allocBlock(); 
         // mut_list always has at least one block.
     }
-
     for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
       scavenge_mutable_list(&generations[g]);
-      evac_gen = g;
-      for (st = generations[g].n_steps-1; st >= 0; st--) {
-       scavenge(&generations[g].steps[st]);
-      }
     }
   }
 
-  /* follow roots from the CAF list (used by GHCi)
-   */
-  evac_gen = 0;
+  // follow roots from the CAF list (used by GHCi)
+  gct->evac_gen = 0;
   markCAFs(mark_root);
 
-  /* follow all the roots that the application knows about.
-   */
-  evac_gen = 0;
+  // follow all the roots that the application knows about.
+  gct->evac_gen = 0;
   GetRoots(mark_root);
 
-  /* Mark the weak pointer list, and prepare to detect dead weak
-   * pointers.
-   */
+  // Mark the weak pointer list, and prepare to detect dead weak pointers.
   markWeakPtrList();
   initWeakForGC();
 
-  /* Mark the stable pointer table.
-   */
+  // Mark the stable pointer table.
   markStablePtrTable(mark_root);
 
   /* -------------------------------------------------------------------------
@@ -478,54 +334,7 @@ GarbageCollect ( rtsBool force_major_gc )
   loop:
     flag = rtsFalse;
 
-    // scavenge static objects 
-    if (major_gc && static_objects != END_OF_STATIC_LIST) {
-       IF_DEBUG(sanity, checkStaticObjects(static_objects));
-       scavenge_static();
-    }
-
-    /* When scavenging the older generations:  Objects may have been
-     * evacuated from generations <= N into older generations, and we
-     * need to scavenge these objects.  We're going to try to ensure that
-     * any evacuations that occur move the objects into at least the
-     * same generation as the object being scavenged, otherwise we
-     * have to create new entries on the mutable list for the older
-     * generation.
-     */
-
-    // scavenge each step in generations 0..maxgen 
-    { 
-      long gen;
-      int st; 
-
-    loop2:
-      // scavenge objects in compacted generation
-      if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
-         (mark_stack_bdescr != NULL && !mark_stack_empty())) {
-         scavenge_mark_stack();
-         flag = rtsTrue;
-      }
-
-      for (gen = RtsFlags.GcFlags.generations; --gen >= 0; ) {
-       for (st = generations[gen].n_steps; --st >= 0; ) {
-         if (gen == 0 && st == 0 && RtsFlags.GcFlags.generations > 1) { 
-           continue; 
-         }
-         stp = &generations[gen].steps[st];
-         evac_gen = gen;
-         if (stp->hp_bd != stp->scan_bd || stp->scan < stp->hp) {
-           scavenge(stp);
-           flag = rtsTrue;
-           goto loop2;
-         }
-         if (stp->new_large_objects != NULL) {
-           scavenge_large(stp);
-           flag = rtsTrue;
-           goto loop2;
-         }
-       }
-      }
-    }
+    scavenge_loop();
 
     // if any blackholes are alive, make the threads that wait on
     // them alive too.
@@ -541,49 +350,12 @@ GarbageCollect ( rtsBool force_major_gc )
     }
   }
 
-  /* Update the pointers from the task list - these are
-   * treated as weak pointers because we want to allow a main thread
-   * to get a BlockedOnDeadMVar exception in the same way as any other
-   * thread.  Note that the threads should all have been retained by
-   * GC by virtue of being on the all_threads list, we're just
-   * updating pointers here.
-   */
-  {
-      Task *task;
-      StgTSO *tso;
-      for (task = all_tasks; task != NULL; task = task->all_link) {
-         if (!task->stopped && task->tso) {
-             ASSERT(task->tso->bound == task);
-             tso = (StgTSO *) isAlive((StgClosure *)task->tso);
-             if (tso == NULL) {
-                 barf("task %p: main thread %d has been GC'd", 
-#ifdef THREADED_RTS
-                      (void *)task->id, 
-#else
-                      (void *)task,
-#endif
-                      task->tso->id);
-             }
-             task->tso = tso;
-         }
-      }
-  }
+  // Update pointers from the Task list
+  update_task_list();
 
   // Now see which stable names are still alive.
   gcStablePtrTable();
 
-  // Tidy the end of the to-space chains 
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-      for (s = 0; s < generations[g].n_steps; s++) {
-         stp = &generations[g].steps[s];
-         if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
-             ASSERT(Bdescr(stp->hp) == stp->hp_bd);
-             stp->hp_bd->free = stp->hp;
-             Bdescr(stp->scavd_hp)->free = stp->scavd_hp;
-         }
-      }
-  }
-
 #ifdef PROFILING
   // We call processHeapClosureForDead() on every closure destroyed during
   // the current garbage collection, so we invoke LdvCensusForDead().
@@ -602,10 +374,73 @@ GarbageCollect ( rtsBool force_major_gc )
 
   IF_DEBUG(sanity, checkGlobalTSOList(rtsFalse));
 
+  // Two-space collector: free the old to-space.
+  // g0s0->old_blocks is the old nursery
+  // g0s0->blocks is to-space from the previous GC
+  if (RtsFlags.GcFlags.generations == 1) {
+      if (g0s0->blocks != NULL) {
+         freeChain(g0s0->blocks);
+         g0s0->blocks = NULL;
+      }
+  }
+
+  // For each workspace, in each thread:
+  //    * clear the BF_EVACUATED flag from each copied block
+  //    * move the copied blocks to the step
+  {
+      gc_thread *thr;
+      step_workspace *ws;
+      bdescr *prev;
+
+      for (t = 0; t < n_threads; t++) {
+         thr = &gc_threads[t];
+
+         for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+             for (s = 0; s < generations[g].n_steps; s++) {
+                 ws = &thr->steps[g][s];
+                 if (g==0 && s==0) continue;
+
+                 ASSERT( ws->scan_bd == ws->todo_bd );
+                 ASSERT( ws->scan_bd ? ws->scan == ws->scan_bd->free : 1 );
+
+                 // Push the final block
+                 if (ws->scan_bd) { push_scan_block(ws->scan_bd, ws); }
+
+                 // update stats: we haven't counted the block at the
+                 // front of the scavd_list yet.
+                 scavd_copied += ws->scavd_list->free - ws->scavd_list->start;
+
+                 ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks);
+
+                 prev = ws->scavd_list;
+                 for (bd = ws->scavd_list; bd != NULL; bd = bd->link) {
+                     bd->flags &= ~BF_EVACUATED;        // now from-space 
+                     prev = bd;
+                 }
+                 prev->link = ws->stp->blocks;
+                 ws->stp->blocks = ws->scavd_list;
+                 ws->stp->n_blocks += ws->n_scavd_blocks;
+                 ASSERT(countBlocks(ws->stp->blocks) == ws->stp->n_blocks);
+             }
+         }
+      }
+  }
+
+  // Two-space collector: swap the semi-spaces around.
+  // Currently: g0s0->old_blocks is the old nursery
+  //            g0s0->blocks is to-space from this GC
+  // We want these the other way around.
+  if (RtsFlags.GcFlags.generations == 1) {
+      bdescr *nursery_blocks = g0s0->old_blocks;
+      nat n_nursery_blocks = g0s0->n_old_blocks;
+      g0s0->old_blocks = g0s0->blocks;
+      g0s0->n_old_blocks = g0s0->n_blocks;
+      g0s0->blocks = nursery_blocks;
+      g0s0->n_blocks = n_nursery_blocks;
+  }
+
   /* run through all the generations/steps and tidy up 
    */
-  copied = new_blocks * BLOCK_SIZE_W;
-  scavd_copied =  new_scavd_blocks * BLOCK_SIZE_W;
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 
     if (g <= N) {
@@ -631,15 +466,6 @@ GarbageCollect ( rtsBool force_major_gc )
       bdescr *next;
       stp = &generations[g].steps[s];
 
-      if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
-       // stats information: how much we copied 
-       if (g <= N) {
-         copied -= stp->hp_bd->start + BLOCK_SIZE_W -
-           stp->hp_bd->free;
-         scavd_copied -= stp->scavd_hpLim - stp->scavd_hp;
-       }
-      }
-
       // for generations we collected... 
       if (g <= N) {
 
@@ -648,7 +474,8 @@ GarbageCollect ( rtsBool force_major_gc )
         * freed blocks will probaby be quickly recycled.
         */
        if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
-           if (stp->is_compacted) {
+           if (stp->is_compacted)
+            {
                // for a compacted step, just shift the new to-space
                // onto the front of the now-compacted existing blocks.
                for (bd = stp->blocks; bd != NULL; bd = bd->link) {
@@ -672,11 +499,10 @@ GarbageCollect ( rtsBool force_major_gc )
                // add the new blocks to the block tally
                stp->n_blocks += stp->n_old_blocks;
                ASSERT(countBlocks(stp->blocks) == stp->n_blocks);
-           } else {
+           }
+           else // not copacted
+           {
                freeChain(stp->old_blocks);
-               for (bd = stp->blocks; bd != NULL; bd = bd->link) {
-                   bd->flags &= ~BF_EVACUATED;  // now from-space 
-               }
            }
            stp->old_blocks = NULL;
            stp->n_old_blocks = 0;
@@ -700,9 +526,9 @@ GarbageCollect ( rtsBool force_major_gc )
        stp->large_objects  = stp->scavenged_large_objects;
        stp->n_large_blocks = stp->n_scavenged_large_blocks;
 
-      } else {
-       // for older generations... 
-       
+      }
+      else // for older generations... 
+      {
        /* For older generations, we need to append the
         * scavenged_large_object list (i.e. large objects that have been
         * promoted during this GC) to the large_object list for that step.
@@ -719,88 +545,14 @@ GarbageCollect ( rtsBool force_major_gc )
     }
   }
 
-  /* Reset the sizes of the older generations when we do a major
-   * collection.
-   *
-   * CURRENT STRATEGY: make all generations except zero the same size.
-   * We have to stay within the maximum heap size, and leave a certain
-   * percentage of the maximum heap size available to allocate into.
-   */
-  if (major_gc && RtsFlags.GcFlags.generations > 1) {
-      nat live, size, min_alloc;
-      nat max  = RtsFlags.GcFlags.maxHeapSize;
-      nat gens = RtsFlags.GcFlags.generations;
-
-      // live in the oldest generations
-      live = oldest_gen->steps[0].n_blocks +
-            oldest_gen->steps[0].n_large_blocks;
-
-      // default max size for all generations except zero
-      size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
-                    RtsFlags.GcFlags.minOldGenSize);
-
-      // minimum size for generation zero
-      min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200,
-                         RtsFlags.GcFlags.minAllocAreaSize);
-
-      // Auto-enable compaction when the residency reaches a
-      // certain percentage of the maximum heap size (default: 30%).
-      if (RtsFlags.GcFlags.generations > 1 &&
-         (RtsFlags.GcFlags.compact ||
-          (max > 0 &&
-           oldest_gen->steps[0].n_blocks > 
-           (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
-         oldest_gen->steps[0].is_compacted = 1;
-//       debugBelch("compaction: on\n", live);
-      } else {
-         oldest_gen->steps[0].is_compacted = 0;
-//       debugBelch("compaction: off\n", live);
-      }
-
-      // if we're going to go over the maximum heap size, reduce the
-      // size of the generations accordingly.  The calculation is
-      // different if compaction is turned on, because we don't need
-      // to double the space required to collect the old generation.
-      if (max != 0) {
-
-         // this test is necessary to ensure that the calculations
-         // below don't have any negative results - we're working
-         // with unsigned values here.
-         if (max < min_alloc) {
-             heapOverflow();
-         }
-
-         if (oldest_gen->steps[0].is_compacted) {
-             if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
-                 size = (max - min_alloc) / ((gens - 1) * 2 - 1);
-             }
-         } else {
-             if ( (size * (gens - 1) * 2) + min_alloc > max ) {
-                 size = (max - min_alloc) / ((gens - 1) * 2);
-             }
-         }
-
-         if (size < live) {
-             heapOverflow();
-         }
-      }
-
-#if 0
-      debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
-             min_alloc, size, max);
-#endif
-
-      for (g = 0; g < gens; g++) {
-         generations[g].max_blocks = size;
-      }
-  }
-
+  // update the max size of older generations after a major GC
+  resize_generations();
+  
   // Guess the amount of live data for stats.
   live = calcLive();
 
-  /* Free the small objects allocated via allocate(), since this will
-   * all have been copied into G0S1 now.  
-   */
+  // Free the small objects allocated via allocate(), since this will
+  // all have been copied into G0S1 now.  
   if (RtsFlags.GcFlags.generations > 1) {
       if (g0s0->blocks != NULL) {
           freeChain(g0s0->blocks);
@@ -814,14 +566,12 @@ GarbageCollect ( rtsBool force_major_gc )
   // Start a new pinned_object_block
   pinned_object_block = NULL;
 
-  /* Free the mark stack.
-   */
+  // Free the mark stack.
   if (mark_stack_bdescr != NULL) {
       freeGroup(mark_stack_bdescr);
   }
 
-  /* Free any bitmaps.
-   */
+  // Free any bitmaps.
   for (g = 0; g <= N; g++) {
       for (s = 0; s < generations[g].n_steps; s++) {
          stp = &generations[g].steps[s];
@@ -832,101 +582,7 @@ GarbageCollect ( rtsBool force_major_gc )
       }
   }
 
-  /* Two-space collector:
-   * Free the old to-space, and estimate the amount of live data.
-   */
-  if (RtsFlags.GcFlags.generations == 1) {
-    nat blocks;
-    
-    /* For a two-space collector, we need to resize the nursery. */
-    
-    /* set up a new nursery.  Allocate a nursery size based on a
-     * function of the amount of live data (by default a factor of 2)
-     * Use the blocks from the old nursery if possible, freeing up any
-     * left over blocks.
-     *
-     * If we get near the maximum heap size, then adjust our nursery
-     * size accordingly.  If the nursery is the same size as the live
-     * data (L), then we need 3L bytes.  We can reduce the size of the
-     * nursery to bring the required memory down near 2L bytes.
-     * 
-     * A normal 2-space collector would need 4L bytes to give the same
-     * performance we get from 3L bytes, reducing to the same
-     * performance at 2L bytes.
-     */
-    blocks = g0s0->n_blocks;
-
-    if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
-        blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
-          RtsFlags.GcFlags.maxHeapSize ) {
-      long adjusted_blocks;  // signed on purpose 
-      int pc_free; 
-      
-      adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
-
-      debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", 
-                RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
-
-      pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
-      if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
-       heapOverflow();
-      }
-      blocks = adjusted_blocks;
-      
-    } else {
-      blocks *= RtsFlags.GcFlags.oldGenFactor;
-      if (blocks < RtsFlags.GcFlags.minAllocAreaSize) {
-       blocks = RtsFlags.GcFlags.minAllocAreaSize;
-      }
-    }
-    resizeNurseries(blocks);
-    
-  } else {
-    /* Generational collector:
-     * If the user has given us a suggested heap size, adjust our
-     * allocation area to make best use of the memory available.
-     */
-
-    if (RtsFlags.GcFlags.heapSizeSuggestion) {
-      long blocks;
-      nat needed = calcNeeded();       // approx blocks needed at next GC 
-
-      /* Guess how much will be live in generation 0 step 0 next time.
-       * A good approximation is obtained by finding the
-       * percentage of g0s0 that was live at the last minor GC.
-       */
-      if (N == 0) {
-       g0s0_pcnt_kept = (new_blocks * 100) / countNurseryBlocks();
-      }
-
-      /* Estimate a size for the allocation area based on the
-       * information available.  We might end up going slightly under
-       * or over the suggested heap size, but we should be pretty
-       * close on average.
-       *
-       * Formula:            suggested - needed
-       *                ----------------------------
-       *                    1 + g0s0_pcnt_kept/100
-       *
-       * where 'needed' is the amount of memory needed at the next
-       * collection for collecting all steps except g0s0.
-       */
-      blocks = 
-       (((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
-       (100 + (long)g0s0_pcnt_kept);
-      
-      if (blocks < (long)RtsFlags.GcFlags.minAllocAreaSize) {
-       blocks = RtsFlags.GcFlags.minAllocAreaSize;
-      }
-      
-      resizeNurseries((nat)blocks);
-
-    } else {
-      // we might have added extra large blocks to the nursery, so
-      // resize back to minAllocAreaSize again.
-      resizeNurseriesFixed(RtsFlags.GcFlags.minAllocAreaSize);
-    }
-  }
+  resize_nursery();
 
  // mark the garbage collected CAFs as dead 
 #if 0 && defined(DEBUG) // doesn't work at the moment 
@@ -1165,6 +821,326 @@ isAlive(StgClosure *p)
   }
 }
 
+/* -----------------------------------------------------------------------------
+   Figure out which generation to collect, initialise N and major_gc.
+   -------------------------------------------------------------------------- */
+
+static void
+initialise_N (rtsBool force_major_gc)
+{
+    nat g;
+
+    if (force_major_gc) {
+       N = RtsFlags.GcFlags.generations - 1;
+       major_gc = rtsTrue;
+    } else {
+       N = 0;
+       for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+           if (generations[g].steps[0].n_blocks +
+               generations[g].steps[0].n_large_blocks
+               >= generations[g].max_blocks) {
+               N = g;
+           }
+       }
+       major_gc = (N == RtsFlags.GcFlags.generations-1);
+    }
+}
+
+/* -----------------------------------------------------------------------------
+   Initialise the gc_thread structures.
+   -------------------------------------------------------------------------- */
+
+static void
+alloc_gc_thread (gc_thread *t, int n)
+{
+    nat g, s;
+    step_workspace *ws;
+
+    t->thread_index = n;
+    t->free_blocks = NULL;
+    t->gc_count = 0;
+
+    init_gc_thread(t);
+    
+    t->steps = stgMallocBytes(RtsFlags.GcFlags.generations * 
+                               sizeof(step_workspace *), 
+                               "initialise_gc_thread");
+
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++)
+    {
+        t->steps[g] = stgMallocBytes(generations[g].n_steps * 
+                                      sizeof(step_workspace),
+                                      "initialise_gc_thread/2");
+
+        for (s = 0; s < generations[g].n_steps; s++)
+        {
+            ws = &t->steps[g][s];
+            ws->stp = &generations[g].steps[s];
+            ws->gct = t;
+
+            ws->scan_bd = NULL;
+            ws->scan = NULL;
+
+           ws->todo_bd = NULL;
+            ws->buffer_todo_bd = NULL;
+
+           ws->scavd_list = NULL;
+           ws->n_scavd_blocks = 0;
+        }
+    }
+}
+
+
+static void
+alloc_gc_threads (void)
+{
+    if (gc_threads == NULL) {
+#if defined(THREADED_RTS)
+        nat i;
+
+       gc_threads = stgMallocBytes (RtsFlags.ParFlags.gcThreads * 
+                                    sizeof(gc_thread), 
+                                    "alloc_gc_threads");
+
+       for (i = 0; i < RtsFlags.ParFlags.gcThreads; i++) {
+           alloc_gc_thread(&gc_threads[i], i);
+       }
+#else
+       gc_threads = stgMallocBytes (sizeof(gc_thread), 
+                                    "alloc_gc_threads");
+
+       alloc_gc_thread(gc_threads, 0);
+#endif
+    }
+}
+
+/* ----------------------------------------------------------------------------
+   Initialise a generation that is to be collected 
+   ------------------------------------------------------------------------- */
+
+static void
+init_collected_gen (nat g, nat n_threads)
+{
+    nat s, t, i;
+    step_workspace *ws;
+    step *stp;
+    bdescr *bd;
+
+    // Throw away the current mutable list.  Invariant: the mutable
+    // list always has at least one block; this means we can avoid a
+    // check for NULL in recordMutable().
+    if (g != 0) {
+       freeChain(generations[g].mut_list);
+       generations[g].mut_list = allocBlock();
+       for (i = 0; i < n_capabilities; i++) {
+           freeChain(capabilities[i].mut_lists[g]);
+           capabilities[i].mut_lists[g] = allocBlock();
+       }
+    }
+
+    for (s = 0; s < generations[g].n_steps; s++) {
+
+       // generation 0, step 0 doesn't need to-space 
+       if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { 
+           continue; 
+       }
+       
+       stp = &generations[g].steps[s];
+       ASSERT(stp->gen_no == g);
+
+       // deprecate the existing blocks
+       stp->old_blocks   = stp->blocks;
+       stp->n_old_blocks = stp->n_blocks;
+       stp->blocks       = NULL;
+       stp->n_blocks     = 0;
+
+       // we don't have any to-be-scavenged blocks yet
+       stp->todos = NULL;
+       stp->n_todos = 0;
+
+       // initialise the large object queues.
+       stp->scavenged_large_objects = NULL;
+       stp->n_scavenged_large_blocks = 0;
+
+       // mark the large objects as not evacuated yet 
+       for (bd = stp->large_objects; bd; bd = bd->link) {
+           bd->flags &= ~BF_EVACUATED;
+       }
+
+       // for a compacted step, we need to allocate the bitmap
+       if (stp->is_compacted) {
+           nat bitmap_size; // in bytes
+           bdescr *bitmap_bdescr;
+           StgWord *bitmap;
+           
+           bitmap_size = stp->n_old_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
+           
+           if (bitmap_size > 0) {
+               bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) 
+                                          / BLOCK_SIZE);
+               stp->bitmap = bitmap_bdescr;
+               bitmap = bitmap_bdescr->start;
+               
+               debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
+                          bitmap_size, bitmap);
+               
+               // don't forget to fill it with zeros!
+               memset(bitmap, 0, bitmap_size);
+               
+               // For each block in this step, point to its bitmap from the
+               // block descriptor.
+               for (bd=stp->old_blocks; bd != NULL; bd = bd->link) {
+                   bd->u.bitmap = bitmap;
+                   bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
+                   
+                   // Also at this point we set the BF_COMPACTED flag
+                   // for this block.  The invariant is that
+                   // BF_COMPACTED is always unset, except during GC
+                   // when it is set on those blocks which will be
+                   // compacted.
+                   bd->flags |= BF_COMPACTED;
+               }
+           }
+       }
+    }
+
+    // For each GC thread, for each step, allocate a "todo" block to
+    // store evacuated objects to be scavenged, and a block to store
+    // evacuated objects that do not need to be scavenged.
+    for (t = 0; t < n_threads; t++) {
+       for (s = 0; s < generations[g].n_steps; s++) {
+
+           // we don't copy objects into g0s0, unless -G0
+           if (g==0 && s==0 && RtsFlags.GcFlags.generations > 1) continue;
+
+           ws = &gc_threads[t].steps[g][s];
+
+           ws->scan_bd = NULL;
+           ws->scan = NULL;
+
+           ws->todo_large_objects = NULL;
+
+           // allocate the first to-space block; extra blocks will be
+           // chained on as necessary.
+           ws->todo_bd = NULL;
+           ws->buffer_todo_bd = NULL;
+           gc_alloc_todo_block(ws);
+
+           // allocate a block for "already scavenged" objects.  This goes
+           // on the front of the stp->blocks list, so it won't be
+           // traversed by the scavenging sweep.
+           ws->scavd_list = NULL;
+           ws->n_scavd_blocks = 0;
+           gc_alloc_scavd_block(ws);
+       }
+    }
+}
+
+
+/* ----------------------------------------------------------------------------
+   Initialise a generation that is *not* to be collected 
+   ------------------------------------------------------------------------- */
+
+static void
+init_uncollected_gen (nat g, nat threads)
+{
+    nat s, t, i;
+    step_workspace *ws;
+    step *stp;
+    bdescr *bd;
+
+    for (s = 0; s < generations[g].n_steps; s++) {
+       stp = &generations[g].steps[s];
+       stp->scavenged_large_objects = NULL;
+       stp->n_scavenged_large_blocks = 0;
+    }
+    
+    for (t = 0; t < threads; t++) {
+       for (s = 0; s < generations[g].n_steps; s++) {
+           
+           ws = &gc_threads[t].steps[g][s];
+           stp = ws->stp;
+           
+           ws->buffer_todo_bd = NULL;
+           ws->todo_large_objects = NULL;
+
+           // If the block at the head of the list in this generation
+           // is less than 3/4 full, then use it as a todo block.
+           if (isPartiallyFull(stp->blocks))
+           {
+               ws->todo_bd = stp->blocks;
+               stp->blocks = stp->blocks->link;
+               stp->n_blocks -= 1;
+               ws->todo_bd->link = NULL;
+
+               // this block is also the scan block; we must scan
+               // from the current end point.
+               ws->scan_bd = ws->todo_bd;
+               ws->scan = ws->scan_bd->free;
+
+               // subtract the contents of this block from the stats,
+               // because we'll count the whole block later.
+               copied -= ws->scan_bd->free - ws->scan_bd->start;
+           } 
+           else
+           {
+               ws->scan_bd = NULL;
+               ws->scan = NULL;
+               ws->todo_bd = NULL;
+               gc_alloc_todo_block(ws);
+           }
+
+           // Do the same trick for the scavd block
+           if (isPartiallyFull(stp->blocks))
+           {
+               ws->scavd_list = stp->blocks;
+               stp->blocks = stp->blocks->link;
+               stp->n_blocks -= 1;
+               ws->scavd_list->link = NULL;
+               ws->n_scavd_blocks = 1;
+               // subtract the contents of this block from the stats,
+               // because we'll count the whole block later.
+               scavd_copied -= ws->scavd_list->free - ws->scavd_list->start;
+           }
+           else
+           {
+               ws->scavd_list = NULL;
+               ws->n_scavd_blocks = 0;
+               gc_alloc_scavd_block(ws);
+           }
+       }
+    }
+
+    // Move the private mutable lists from each capability onto the
+    // main mutable list for the generation.
+    for (i = 0; i < n_capabilities; i++) {
+       for (bd = capabilities[i].mut_lists[g]; 
+            bd->link != NULL; bd = bd->link) {
+           /* nothing */
+       }
+       bd->link = generations[g].mut_list;
+       generations[g].mut_list = capabilities[i].mut_lists[g];
+       capabilities[i].mut_lists[g] = allocBlock();
+    }
+}
+
+/* -----------------------------------------------------------------------------
+   Initialise a gc_thread before GC
+   -------------------------------------------------------------------------- */
+
+static void
+init_gc_thread (gc_thread *t)
+{
+    t->evac_gen = 0;
+    t->failed_to_evac = rtsFalse;
+    t->eager_promotion = rtsTrue;
+    t->thunk_selector_depth = 0;
+}
+
+/* -----------------------------------------------------------------------------
+   Function we pass to GetRoots to evacuate roots.
+   -------------------------------------------------------------------------- */
+
 static void
 mark_root(StgClosure **root)
 {
@@ -1225,6 +1201,236 @@ markCAFs( evac_fn evac )
     }
 }
 
+/* ----------------------------------------------------------------------------
+   Update the pointers from the task list
+
+   These are treated as weak pointers because we want to allow a main
+   thread to get a BlockedOnDeadMVar exception in the same way as any
+   other thread.  Note that the threads should all have been retained
+   by GC by virtue of being on the all_threads list, we're just
+   updating pointers here.
+   ------------------------------------------------------------------------- */
+
+static void
+update_task_list (void)
+{
+    Task *task;
+    StgTSO *tso;
+    for (task = all_tasks; task != NULL; task = task->all_link) {
+       if (!task->stopped && task->tso) {
+           ASSERT(task->tso->bound == task);
+           tso = (StgTSO *) isAlive((StgClosure *)task->tso);
+           if (tso == NULL) {
+               barf("task %p: main thread %d has been GC'd", 
+#ifdef THREADED_RTS
+                    (void *)task->id, 
+#else
+                    (void *)task,
+#endif
+                    task->tso->id);
+           }
+           task->tso = tso;
+       }
+    }
+}
+
+/* ----------------------------------------------------------------------------
+   Reset the sizes of the older generations when we do a major
+   collection.
+  
+   CURRENT STRATEGY: make all generations except zero the same size.
+   We have to stay within the maximum heap size, and leave a certain
+   percentage of the maximum heap size available to allocate into.
+   ------------------------------------------------------------------------- */
+
+static void
+resize_generations (void)
+{
+    nat g;
+
+    if (major_gc && RtsFlags.GcFlags.generations > 1) {
+       nat live, size, min_alloc;
+       nat max  = RtsFlags.GcFlags.maxHeapSize;
+       nat gens = RtsFlags.GcFlags.generations;
+       
+       // live in the oldest generations
+       live = oldest_gen->steps[0].n_blocks +
+           oldest_gen->steps[0].n_large_blocks;
+       
+       // default max size for all generations except zero
+       size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
+                      RtsFlags.GcFlags.minOldGenSize);
+       
+       // minimum size for generation zero
+       min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200,
+                           RtsFlags.GcFlags.minAllocAreaSize);
+
+       // Auto-enable compaction when the residency reaches a
+       // certain percentage of the maximum heap size (default: 30%).
+       if (RtsFlags.GcFlags.generations > 1 &&
+           (RtsFlags.GcFlags.compact ||
+            (max > 0 &&
+             oldest_gen->steps[0].n_blocks > 
+             (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
+           oldest_gen->steps[0].is_compacted = 1;
+//       debugBelch("compaction: on\n", live);
+       } else {
+           oldest_gen->steps[0].is_compacted = 0;
+//       debugBelch("compaction: off\n", live);
+       }
+
+       // if we're going to go over the maximum heap size, reduce the
+       // size of the generations accordingly.  The calculation is
+       // different if compaction is turned on, because we don't need
+       // to double the space required to collect the old generation.
+       if (max != 0) {
+           
+           // this test is necessary to ensure that the calculations
+           // below don't have any negative results - we're working
+           // with unsigned values here.
+           if (max < min_alloc) {
+               heapOverflow();
+           }
+           
+           if (oldest_gen->steps[0].is_compacted) {
+               if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
+                   size = (max - min_alloc) / ((gens - 1) * 2 - 1);
+               }
+           } else {
+               if ( (size * (gens - 1) * 2) + min_alloc > max ) {
+                   size = (max - min_alloc) / ((gens - 1) * 2);
+               }
+           }
+           
+           if (size < live) {
+               heapOverflow();
+           }
+       }
+       
+#if 0
+       debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
+                  min_alloc, size, max);
+#endif
+       
+       for (g = 0; g < gens; g++) {
+           generations[g].max_blocks = size;
+       }
+    }
+}
+
+/* -----------------------------------------------------------------------------
+   Calculate the new size of the nursery, and resize it.
+   -------------------------------------------------------------------------- */
+
+static void
+resize_nursery (void)
+{
+    if (RtsFlags.GcFlags.generations == 1)
+    {   // Two-space collector:
+       nat blocks;
+    
+       /* set up a new nursery.  Allocate a nursery size based on a
+        * function of the amount of live data (by default a factor of 2)
+        * Use the blocks from the old nursery if possible, freeing up any
+        * left over blocks.
+        *
+        * If we get near the maximum heap size, then adjust our nursery
+        * size accordingly.  If the nursery is the same size as the live
+        * data (L), then we need 3L bytes.  We can reduce the size of the
+        * nursery to bring the required memory down near 2L bytes.
+        * 
+        * A normal 2-space collector would need 4L bytes to give the same
+        * performance we get from 3L bytes, reducing to the same
+        * performance at 2L bytes.
+        */
+       blocks = g0s0->n_old_blocks;
+       
+       if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
+            blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
+            RtsFlags.GcFlags.maxHeapSize )
+       {
+           long adjusted_blocks;  // signed on purpose 
+           int pc_free; 
+           
+           adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
+           
+           debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", 
+                      RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
+           
+           pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
+           if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even * be < 0 */
+           {
+               heapOverflow();
+           }
+           blocks = adjusted_blocks;
+       }
+       else
+       {
+           blocks *= RtsFlags.GcFlags.oldGenFactor;
+           if (blocks < RtsFlags.GcFlags.minAllocAreaSize)
+           {
+               blocks = RtsFlags.GcFlags.minAllocAreaSize;
+           }
+       }
+       resizeNurseries(blocks);
+    }
+    else  // Generational collector
+    {
+       /* 
+        * If the user has given us a suggested heap size, adjust our
+        * allocation area to make best use of the memory available.
+        */
+       if (RtsFlags.GcFlags.heapSizeSuggestion)
+       {
+           long blocks;
+           nat needed = calcNeeded();  // approx blocks needed at next GC 
+           
+           /* Guess how much will be live in generation 0 step 0 next time.
+            * A good approximation is obtained by finding the
+            * percentage of g0s0 that was live at the last minor GC.
+            *
+            * We have an accurate figure for the amount of copied data in
+            * 'copied', but we must convert this to a number of blocks, with
+            * a small adjustment for estimated slop at the end of a block
+            * (- 10 words).
+            */
+           if (N == 0)
+           {
+               g0s0_pcnt_kept = ((copied / (BLOCK_SIZE_W - 10)) * 100)
+                   / countNurseryBlocks();
+           }
+           
+           /* Estimate a size for the allocation area based on the
+            * information available.  We might end up going slightly under
+            * or over the suggested heap size, but we should be pretty
+            * close on average.
+            *
+            * Formula:            suggested - needed
+            *                ----------------------------
+            *                    1 + g0s0_pcnt_kept/100
+            *
+            * where 'needed' is the amount of memory needed at the next
+            * collection for collecting all steps except g0s0.
+            */
+           blocks = 
+               (((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
+               (100 + (long)g0s0_pcnt_kept);
+           
+           if (blocks < (long)RtsFlags.GcFlags.minAllocAreaSize) {
+               blocks = RtsFlags.GcFlags.minAllocAreaSize;
+           }
+           
+           resizeNurseries((nat)blocks);
+       }
+       else
+       {
+           // we might have added extra large blocks to the nursery, so
+           // resize back to minAllocAreaSize again.
+           resizeNurseriesFixed(RtsFlags.GcFlags.minAllocAreaSize);
+       }
+    }
+}
+
 /* -----------------------------------------------------------------------------
    Sanity code for CAF garbage collection.
 
@@ -1275,25 +1481,3 @@ gcCAFs(void)
   debugTrace(DEBUG_gccafs, "%d CAFs live", i); 
 }
 #endif
-
-/* -----------------------------------------------------------------------------
- * Debugging
- * -------------------------------------------------------------------------- */
-
-#if DEBUG
-void
-printMutableList(generation *gen)
-{
-    bdescr *bd;
-    StgPtr p;
-
-    debugBelch("mutable list %p: ", gen->mut_list);
-
-    for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
-       for (p = bd->start; p < bd->free; p++) {
-           debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
-       }
-    }
-    debugBelch("\n");
-}
-#endif /* DEBUG */