Merge branch 'master' into atomics
[ghc.git] / rts / sm / GC.c
index 9f69a4c..8bbdda2 100644 (file)
@@ -6,7 +6,7 @@
  *
  * Documentation on the architecture of the Garbage Collector can be
  * found in the online commentary:
- * 
+ *
  *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  *
  * ---------------------------------------------------------------------------*/
 #include "Rts.h"
 #include "HsFFI.h"
 
+#include "GC.h"
+#include "GCThread.h"
+#include "GCTDecl.h"            // NB. before RtsSignals.h which
+                                // clobbers REG_R1 on arm/Linux
+#include "Compact.h"
+#include "Evac.h"
+#include "Scav.h"
+#include "GCUtils.h"
+#include "MarkStack.h"
+#include "MarkWeak.h"
+#include "Sparks.h"
+#include "Sweep.h"
+
 #include "Storage.h"
 #include "RtsUtils.h"
 #include "Apply.h"
 #include "Prelude.h"
 #include "RtsSignals.h"
 #include "STM.h"
-#if defined(RTS_GTK_FRONTPANEL)
-#include "FrontPanel.h"
-#endif
 #include "Trace.h"
 #include "RetainerProfile.h"
 #include "LdvProfile.h"
 #include "RaiseAsync.h"
 #include "Papi.h"
 #include "Stable.h"
-
-#include "GC.h"
-#include "GCThread.h"
-#include "GCTDecl.h"
-#include "Compact.h"
-#include "Evac.h"
-#include "Scav.h"
-#include "GCUtils.h"
-#include "MarkStack.h"
-#include "MarkWeak.h"
-#include "Sparks.h"
-#include "Sweep.h"
+#include "CheckUnload.h"
 
 #include <string.h> // for memset()
 #include <unistd.h>
  * linking objects on to the list.  We use a stack-type list, consing
  * objects on the front as they are added (this means that the
  * scavenge phase is depth-first, not breadth-first, but that
- * shouldn't matter).  
+ * shouldn't matter).
  *
  * A separate list is kept for objects that have been scavenged
  * already - this is so that we can zero all the marks afterwards.
  *
  * An object is on the list if its static link field is non-zero; this
- * means that we have to mark the end of the list with '1', not NULL.  
+ * means that we have to mark the end of the list with '1', not NULL.
  *
  * Extra notes for generational GC:
  *
@@ -102,13 +101,19 @@ rtsBool major_gc;
 
 /* Data used for allocation area sizing.
  */
-static lnat g0_pcnt_kept = 30; // percentage of g0 live at last minor GC 
+static W_ g0_pcnt_kept = 30; // percentage of g0 live at last minor GC
 
 /* Mut-list stats */
 #ifdef DEBUG
 nat mutlist_MUTVARS,
     mutlist_MUTARRS,
     mutlist_MVARS,
+    mutlist_TVAR,
+    mutlist_TVAR_WATCH_QUEUE,
+    mutlist_TREC_CHUNK,
+    mutlist_TREC_HEADER,
+    mutlist_ATOMIC_INVARIANT,
+    mutlist_INVARIANT_CHECK_QUEUE,
     mutlist_OTHERS;
 #endif
 
@@ -137,7 +142,6 @@ DECLARE_GCT
 
 static void mark_root               (void *user, StgClosure **root);
 static void zero_static_object_list (StgClosure* first_static);
-static nat  initialise_N            (rtsBool force_major_gc);
 static void prepare_collected_gen   (generation *gen);
 static void prepare_uncollected_gen (generation *gen);
 static void init_gc_thread          (gc_thread *t);
@@ -150,6 +154,7 @@ static StgWord dec_running          (void);
 static void wakeup_gc_threads       (nat me);
 static void shutdown_gc_threads     (nat me);
 static void collect_gct_blocks      (void);
+static void collect_pinned_object_blocks (void);
 
 #if 0 && defined(DEBUG)
 static void gcCAFs                  (void);
@@ -166,17 +171,20 @@ StgPtr mark_sp;            // pointer to the next unallocated mark stack entry
 /* -----------------------------------------------------------------------------
    GarbageCollect: the main entry point to the garbage collector.
 
+   The collect_gen parameter is gotten by calling calcNeeded().
+
    Locks held: all capabilities are held throughout GarbageCollect().
    -------------------------------------------------------------------------- */
 
 void
-GarbageCollect (rtsBool force_major_gc, 
+GarbageCollect (nat collect_gen,
+                rtsBool do_heap_census,
                 nat gc_type USED_IF_THREADS,
                 Capability *cap)
 {
   bdescr *bd;
   generation *gen;
-  lnat live_blocks, live_words, allocated, max_copied, avg_copied;
+  StgWord live_blocks, live_words, par_max_copied, par_tot_copied;
 #if defined(THREADED_RTS)
   gc_thread *saved_gct;
 #endif
@@ -188,7 +196,7 @@ GarbageCollect (rtsBool force_major_gc,
 #endif
 
 #ifdef PROFILING
-  CostCentreStack *prev_CCS;
+  CostCentreStack *save_CCS[n_capabilities];
 #endif
 
   ACQUIRE_SM_LOCK;
@@ -206,32 +214,37 @@ GarbageCollect (rtsBool force_major_gc,
   // this is the main thread
   SET_GCT(gc_threads[cap->no]);
 
-  // tell the stats department that we've started a GC 
-  stat_startGC(gct);
+  // tell the stats department that we've started a GC
+  stat_startGC(cap, gct);
 
   // lock the StablePtr table
-  stablePtrPreGC();
+  stableLock();
 
 #ifdef DEBUG
   mutlist_MUTVARS = 0;
   mutlist_MUTARRS = 0;
+  mutlist_MVARS = 0;
+  mutlist_TVAR = 0;
+  mutlist_TVAR_WATCH_QUEUE = 0;
+  mutlist_TREC_CHUNK = 0;
+  mutlist_TREC_HEADER = 0;
+  mutlist_ATOMIC_INVARIANT = 0;
+  mutlist_INVARIANT_CHECK_QUEUE = 0;
   mutlist_OTHERS = 0;
 #endif
 
-  // attribute any costs to CCS_GC 
+  // attribute any costs to CCS_GC
 #ifdef PROFILING
-  prev_CCS = CCCS;
-  CCCS = CCS_GC;
+  for (n = 0; n < n_capabilities; n++) {
+      save_CCS[n] = capabilities[n].r.rCCCS;
+      capabilities[n].r.rCCCS = CCS_GC;
+  }
 #endif
 
-  /* Approximate how much we allocated.  
-   * Todo: only when generating stats? 
-   */
-  allocated = calcAllocated(rtsFalse/* don't count the nursery yet */);
-
   /* Figure out which generation to collect
    */
-  n = initialise_N(force_major_gc);
+  N = collect_gen;
+  major_gc = (N == RtsFlags.GcFlags.generations-1);
 
 #if defined(THREADED_RTS)
   work_stealing = RtsFlags.ParFlags.parGcLoadBalancingEnabled &&
@@ -239,7 +252,7 @@ GarbageCollect (rtsBool force_major_gc,
       // It's not always a good idea to do load balancing in parallel
       // GC.  In particular, for a parallel program we don't want to
       // lose locality by moving cached data into another CPU's cache
-      // (this effect can be quite significant). 
+      // (this effect can be quite significant).
       //
       // We could have a more complex way to deterimine whether to do
       // work stealing or not, e.g. it might be a good idea to do it
@@ -256,8 +269,8 @@ GarbageCollect (rtsBool force_major_gc,
    * We don't try to parallelise minor GCs (unless the user asks for
    * it with +RTS -gn0), or mark/compact/sweep GC.
    */
-  if (gc_type == PENDING_GC_PAR) {
-      n_gc_threads = RtsFlags.ParFlags.nNodes;
+  if (gc_type == SYNC_GC_PAR) {
+      n_gc_threads = n_capabilities;
   } else {
       n_gc_threads = 1;
   }
@@ -265,23 +278,21 @@ GarbageCollect (rtsBool force_major_gc,
   n_gc_threads = 1;
 #endif
 
-  debugTrace(DEBUG_gc, "GC (gen %d): %d KB to collect, %ld MB in use, using %d thread(s)",
-        N, n * (BLOCK_SIZE / 1024), mblocks_allocated, n_gc_threads);
-
-#ifdef RTS_GTK_FRONTPANEL
-  if (RtsFlags.GcFlags.frontpanel) {
-      updateFrontPanelBeforeGC(N);
-  }
-#endif
+  debugTrace(DEBUG_gc, "GC (gen %d, using %d thread(s))",
+             N, n_gc_threads);
 
 #ifdef DEBUG
-  // check for memory leaks if DEBUG is on 
+  // check for memory leaks if DEBUG is on
   memInventory(DEBUG_gc);
 #endif
 
   // check sanity *before* GC
   IF_DEBUG(sanity, checkSanity(rtsFalse /* before GC */, major_gc));
 
+  // gather blocks allocated using allocatePinned() from each capability
+  // and put them on the g0->large_object list.
+  collect_pinned_object_blocks();
+
   // Initialise all the generations/steps that we're collecting.
   for (g = 0; g <= N; g++) {
       prepare_collected_gen(&generations[g]);
@@ -335,6 +346,13 @@ GarbageCollect (rtsBool force_major_gc,
       }
   } else {
       scavenge_capability_mut_lists(gct->cap);
+      for (n = 0; n < n_capabilities; n++) {
+          if (gc_threads[n]->idle) {
+              markCapability(mark_root, gct, &capabilities[n],
+                             rtsTrue/*don't mark sparks*/);
+              scavenge_capability_mut_lists(&capabilities[n]);
+          }
+      }
   }
 
   // follow roots from the CAF list (used by GHCi)
@@ -364,7 +382,7 @@ GarbageCollect (rtsBool force_major_gc,
   initWeakForGC();
 
   // Mark the stable pointer table.
-  markStablePtrTable(mark_root, gct);
+  markStableTables(mark_root, gct);
 
   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
@@ -375,10 +393,10 @@ GarbageCollect (rtsBool force_major_gc,
       scavenge_until_all_done();
       // The other threads are now stopped.  We might recurse back to
       // here, but from now on this is the only thread.
-      
+
       // must be last...  invariant is that everything is fully
       // scavenged at this point.
-      if (traverseWeakPtrList()) { // returns rtsTrue if evaced something 
+      if (traverseWeakPtrList()) { // returns rtsTrue if evaced something
          inc_running();
          continue;
       }
@@ -387,10 +405,14 @@ GarbageCollect (rtsBool force_major_gc,
       break;
   }
 
+  if (!DEBUG_IS_ON && n_gc_threads != 1) {
+      clearNursery(cap);
+  }
+
   shutdown_gc_threads(gct->thread_index);
 
   // Now see which stable names are still alive.
-  gcStablePtrTable();
+  gcStableTables();
 
 #ifdef THREADED_RTS
   if (n_gc_threads == 1) {
@@ -398,7 +420,11 @@ GarbageCollect (rtsBool force_major_gc,
           pruneSparkQueue(&capabilities[n]);
       }
   } else {
-      pruneSparkQueue(gct->cap);
+      for (n = 0; n < n_capabilities; n++) {
+          if (n == cap->no || gc_threads[n]->idle) {
+              pruneSparkQueue(&capabilities[n]);
+         }
+      }
   }
 #endif
 
@@ -406,24 +432,27 @@ GarbageCollect (rtsBool force_major_gc,
   // We call processHeapClosureForDead() on every closure destroyed during
   // the current garbage collection, so we invoke LdvCensusForDead().
   if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
-      || RtsFlags.ProfFlags.bioSelector != NULL)
-    LdvCensusForDead(N);
+      || RtsFlags.ProfFlags.bioSelector != NULL) {
+      RELEASE_SM_LOCK; // LdvCensusForDead may need to take the lock
+      LdvCensusForDead(N);
+      ACQUIRE_SM_LOCK;
+  }
 #endif
 
   // NO MORE EVACUATION AFTER THIS POINT!
 
   // Finally: compact or sweep the oldest generation.
   if (major_gc && oldest_gen->mark) {
-      if (oldest_gen->compact) 
+      if (oldest_gen->compact)
           compact(gct->scavenged_static_objects);
       else
           sweep(oldest_gen);
   }
 
   copied = 0;
-  max_copied = 0;
-  avg_copied = 0;
-  { 
+  par_max_copied = 0;
+  par_tot_copied = 0;
+  {
       nat i;
       for (i=0; i < n_gc_threads; i++) {
           if (n_gc_threads > 1) {
@@ -435,13 +464,12 @@ GarbageCollect (rtsBool force_major_gc,
               debugTrace(DEBUG_gc,"   scav_find_work %ld",   gc_threads[i]->scav_find_work);
           }
           copied += gc_threads[i]->copied;
-          max_copied = stg_max(gc_threads[i]->copied, max_copied);
+          par_max_copied = stg_max(gc_threads[i]->copied, par_max_copied);
       }
+      par_tot_copied = copied;
       if (n_gc_threads == 1) {
-          max_copied = 0;
-          avg_copied = 0;
-      } else {
-          avg_copied = copied;
+          par_max_copied = 0;
+          par_tot_copied = 0;
       }
   }
 
@@ -458,29 +486,34 @@ GarbageCollect (rtsBool force_major_gc,
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 
     if (g == N) {
-      generations[g].collections++; // for stats 
+      generations[g].collections++; // for stats
       if (n_gc_threads > 1) generations[g].par_collections++;
     }
 
     // Count the mutable list as bytes "copied" for the purposes of
     // stats.  Every mutable list is copied during every GC.
     if (g > 0) {
-       nat mut_list_size = 0;
+        W_ mut_list_size = 0;
         for (n = 0; n < n_capabilities; n++) {
             mut_list_size += countOccupied(capabilities[n].mut_lists[g]);
         }
        copied +=  mut_list_size;
 
        debugTrace(DEBUG_gc,
-                  "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d others)",
+                  "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d TVARs, %d TVAR_WATCH_QUEUEs, %d TREC_CHUNKs, %d TREC_HEADERs, %d ATOMIC_INVARIANTs, %d INVARIANT_CHECK_QUEUEs, %d others)",
                   (unsigned long)(mut_list_size * sizeof(W_)),
-                  mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS, mutlist_OTHERS);
+                   mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS,
+                   mutlist_TVAR, mutlist_TVAR_WATCH_QUEUE,
+                   mutlist_TREC_CHUNK, mutlist_TREC_HEADER,
+                   mutlist_ATOMIC_INVARIANT,
+                   mutlist_INVARIANT_CHECK_QUEUE,
+                   mutlist_OTHERS);
     }
 
     bdescr *next, *prev;
     gen = &generations[g];
 
-    // for generations we collected... 
+    // for generations we collected...
     if (g <= N) {
 
        /* free old memory and shift to-space into from-space for all
@@ -491,12 +524,12 @@ GarbageCollect (rtsBool force_major_gc,
         {
             // tack the new blocks on the end of the existing blocks
             if (gen->old_blocks != NULL) {
-                
+
                 prev = NULL;
                 for (bd = gen->old_blocks; bd != NULL; bd = next) {
-                    
+
                     next = bd->link;
-                    
+
                     if (!(bd->flags & BF_MARKED))
                     {
                         if (prev == NULL) {
@@ -510,17 +543,17 @@ GarbageCollect (rtsBool force_major_gc,
                     else
                     {
                         gen->n_words += bd->free - bd->start;
-                        
+
                         // NB. this step might not be compacted next
                         // time, so reset the BF_MARKED flags.
                         // They are set before GC if we're going to
                         // compact.  (search for BF_MARKED above).
                         bd->flags &= ~BF_MARKED;
-                        
+
                         // between GCs, all blocks in the heap except
                         // for the nursery have the BF_EVACUATED flag set.
                         bd->flags |= BF_EVACUATED;
-                        
+
                         prev = bd;
                     }
                 }
@@ -551,6 +584,7 @@ GarbageCollect (rtsBool force_major_gc,
         freeChain(gen->large_objects);
         gen->large_objects  = gen->scavenged_large_objects;
         gen->n_large_blocks = gen->n_scavenged_large_blocks;
+        gen->n_large_words  = countOccupied(gen->large_objects);
         gen->n_new_large_words = 0;
     }
     else // for generations > N
@@ -562,13 +596,15 @@ GarbageCollect (rtsBool force_major_gc,
        for (bd = gen->scavenged_large_objects; bd; bd = next) {
             next = bd->link;
             dbl_link_onto(bd, &gen->large_objects);
-       }
-        
-       // add the new blocks we promoted during this GC 
+            gen->n_large_words += bd->free - bd->start;
+        }
+
+       // add the new blocks we promoted during this GC
        gen->n_large_blocks += gen->n_scavenged_large_blocks;
     }
 
     ASSERT(countBlocks(gen->large_objects) == gen->n_large_blocks);
+    ASSERT(countOccupied(gen->large_objects) == gen->n_large_words);
 
     gen->scavenged_large_objects = NULL;
     gen->n_scavenged_large_blocks = 0;
@@ -590,7 +626,7 @@ GarbageCollect (rtsBool force_major_gc,
 
   // update the max size of older generations after a major GC
   resize_generations();
-  
+
   // Free the mark stack.
   if (mark_stack_top_bd != NULL) {
       debugTrace(DEBUG_gc, "mark stack: %d blocks",
@@ -608,51 +644,67 @@ GarbageCollect (rtsBool force_major_gc,
   }
 
   // Reset the nursery: make the blocks empty
-  allocated += clearNurseries();
+  if (DEBUG_IS_ON || n_gc_threads == 1) {
+      for (n = 0; n < n_capabilities; n++) {
+          clearNursery(&capabilities[n]);
+      }
+  } else {
+      // When doing parallel GC, clearNursery() is called by the
+      // worker threads
+      for (n = 0; n < n_capabilities; n++) {
+          if (gc_threads[n]->idle) {
+              clearNursery(&capabilities[n]);
+          }
+      }
+  }
 
   resize_nursery();
 
   resetNurseries();
 
+  if (major_gc) {
+      checkUnload (gct->scavenged_static_objects);
+  }
+
  // mark the garbage collected CAFs as dead
-#if 0 && defined(DEBUG) // doesn't work at the moment 
+#if 0 && defined(DEBUG) // doesn't work at the moment
   if (major_gc) { gcCAFs(); }
 #endif
-  
+
 #ifdef PROFILING
   // resetStaticObjectForRetainerProfiling() must be called before
   // zeroing below.
-  if (n_gc_threads > 1) {
-      barf("profiling is currently broken with multi-threaded GC");
-      // ToDo: fix the gct->scavenged_static_objects below
-  }
+
+  // ToDo: fix the gct->scavenged_static_objects below
   resetStaticObjectForRetainerProfiling(gct->scavenged_static_objects);
 #endif
 
-  // zero the scavenged static object list 
+  // zero the scavenged static object list
   if (major_gc) {
       nat i;
       if (n_gc_threads == 1) {
           zero_static_object_list(gct->scavenged_static_objects);
       } else {
           for (i = 0; i < n_gc_threads; i++) {
-              zero_static_object_list(gc_threads[i]->scavenged_static_objects);
+              if (!gc_threads[i]->idle) {
+                  zero_static_object_list(gc_threads[i]->scavenged_static_objects);
+              }
           }
       }
   }
 
   // Update the stable pointer hash table.
-  updateStablePtrTable(major_gc);
+  updateStableTables(major_gc);
 
   // unlock the StablePtr table.  Must be before scheduleFinalizers(),
   // because a finalizer may call hs_free_fun_ptr() or
   // hs_free_stable_ptr(), both of which access the StablePtr table.
-  stablePtrPostGC();
+  stableUnlock();
 
   // Start any pending finalizers.  Must be after
-  // updateStablePtrTable() and stablePtrPostGC() (see #4221).
+  // updateStableTables() and stableUnlock() (see #4221).
   RELEASE_SM_LOCK;
-  scheduleFinalizers(cap, old_weak_ptr_list);
+  scheduleFinalizers(cap, dead_weak_ptr_list);
   ACQUIRE_SM_LOCK;
 
   // check sanity after GC
@@ -661,13 +713,24 @@ 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");
+      RELEASE_SM_LOCK;
+      heapCensus(gct->gc_start_cpu);
+      ACQUIRE_SM_LOCK;
+  }
+
   // send exceptions to any threads which were about to die
   RELEASE_SM_LOCK;
   resurrectThreads(resurrected_threads);
   ACQUIRE_SM_LOCK;
 
   if (major_gc) {
-      nat need, got;
+      W_ need, got;
       need = BLOCKS_TO_MBLOCKS(n_alloc_blocks);
       got = mblocks_allocated;
       /* If the amount of data remains constant, next major GC we'll
@@ -683,33 +746,26 @@ GarbageCollect (rtsBool force_major_gc,
   IF_DEBUG(gc, statDescribeGens());
 
 #ifdef DEBUG
-  // symbol-table based profiling 
+  // symbol-table based profiling
   /*  heapCensus(to_blocks); */ /* ToDo */
 #endif
 
-  // restore enclosing cost centre 
+  // restore enclosing cost centre
 #ifdef PROFILING
-  CCCS = prev_CCS;
+  for (n = 0; n < n_capabilities; n++) {
+      capabilities[n].r.rCCCS = save_CCS[n];
+  }
 #endif
 
 #ifdef DEBUG
-  // check for memory leaks if DEBUG is on 
+  // check for memory leaks if DEBUG is on
   memInventory(DEBUG_gc);
 #endif
 
-#ifdef RTS_GTK_FRONTPANEL
-  if (RtsFlags.GcFlags.frontpanel) {
-      updateFrontPanelAfterGC( N, live );
-  }
-#endif
-
-  // ok, GC over: tell the stats department what happened. 
-  stat_endGC(gct, allocated, live_words,
-             copied, N, max_copied, avg_copied,
-             live_blocks * BLOCK_SIZE_W - live_words /* slop */);
-
-  // Guess which generation we'll collect *next* time
-  initialise_N(force_major_gc);
+  // ok, GC over: tell the stats department what happened.
+  stat_endGC(cap, gct, live_words, copied,
+             live_blocks * BLOCK_SIZE_W - live_words /* slop */,
+             N, n_gc_threads, par_max_copied, par_tot_copied);
 
 #if defined(RTS_USER_SIGNALS)
   if (RtsFlags.MiscFlags.install_signal_handlers) {
@@ -724,47 +780,6 @@ GarbageCollect (rtsBool force_major_gc,
 }
 
 /* -----------------------------------------------------------------------------
-   Figure out which generation to collect, initialise N and major_gc.
-
-   Also returns the total number of blocks in generations that will be
-   collected.
-   -------------------------------------------------------------------------- */
-
-static nat
-initialise_N (rtsBool force_major_gc)
-{
-    int g;
-    nat blocks, blocks_total;
-
-    blocks = 0;
-    blocks_total = 0;
-
-    if (force_major_gc) {
-        N = RtsFlags.GcFlags.generations - 1;
-    } else {
-        N = 0;
-    }
-
-    for (g = RtsFlags.GcFlags.generations - 1; g >= 0; g--) {
-
-        blocks = generations[g].n_words / BLOCK_SIZE_W
-               + generations[g].n_large_blocks;
-
-        if (blocks >= generations[g].max_blocks) {
-            N = stg_max(N,g);
-        }
-        if ((nat)g <= N) {
-            blocks_total += blocks;
-        }
-    }
-
-    blocks_total += countNurseryBlocks();
-
-    major_gc = (N == RtsFlags.GcFlags.generations-1);
-    return blocks_total;
-}
-
-/* -----------------------------------------------------------------------------
    Initialise the gc_thread structures.
    -------------------------------------------------------------------------- */
 
@@ -791,11 +806,12 @@ new_gc_thread (nat n, gc_thread *t)
 #endif
 
     t->thread_index = n;
+    t->idle = rtsFalse;
     t->free_blocks = NULL;
     t->gc_count = 0;
 
     init_gc_thread(t);
-    
+
 #ifdef USE_PAPI
     t->papi_events = -1;
 #endif
@@ -806,7 +822,7 @@ new_gc_thread (nat n, gc_thread *t)
         ws->gen = &generations[g];
         ASSERT(g == ws->gen->no);
         ws->my_gct = t;
-        
+
         // We want to call
         //   alloc_todo_block(ws,0);
         // but can't, because it uses gct which isn't set up at this point.
@@ -837,29 +853,39 @@ new_gc_thread (nat n, gc_thread *t)
 
 
 void
-initGcThreads (void)
+initGcThreads (nat from USED_IF_THREADS, nat to USED_IF_THREADS)
 {
-    if (gc_threads == NULL) {
 #if defined(THREADED_RTS)
-        nat i;
-       gc_threads = stgMallocBytes (RtsFlags.ParFlags.nNodes * 
-                                    sizeof(gc_thread*), 
-                                    "alloc_gc_threads");
+    nat i;
+
+    if (from > 0) {
+        gc_threads = stgReallocBytes (gc_threads, to * sizeof(gc_thread*),
+                                      "initGcThreads");
+    } else {
+        gc_threads = stgMallocBytes (to * sizeof(gc_thread*),
+                                     "initGcThreads");
+    }
 
-       for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
-            gc_threads[i] = 
-                stgMallocBytes(sizeof(gc_thread) + 
-                               RtsFlags.GcFlags.generations * sizeof(gen_workspace),
-                               "alloc_gc_threads");
+    // We have to update the gct->cap pointers to point to the new
+    // Capability array now.
+    for (i = 0; i < from; i++) {
+        gc_threads[i]->cap = &capabilities[gc_threads[i]->cap->no];
+    }
 
-            new_gc_thread(i, gc_threads[i]);
-       }
+    for (i = from; i < to; i++) {
+        gc_threads[i] =
+            stgMallocBytes(sizeof(gc_thread) +
+                           RtsFlags.GcFlags.generations * sizeof(gen_workspace),
+                           "alloc_gc_threads");
+
+        new_gc_thread(i, gc_threads[i]);
+    }
 #else
-        gc_threads = stgMallocBytes (sizeof(gc_thread*),"alloc_gc_threads");
-       gc_threads[0] = gct;
-        new_gc_thread(0,gc_threads[0]);
+    ASSERT(from == 0 && to == 1);
+    gc_threads = stgMallocBytes (sizeof(gc_thread*),"alloc_gc_threads");
+    gc_threads[0] = gct;
+    new_gc_thread(0,gc_threads[0]);
 #endif
-    }
 }
 
 void
@@ -898,7 +924,7 @@ static StgWord
 inc_running (void)
 {
     StgWord new;
-    new = atomic_inc(&gc_running_threads);
+    new = atomic_inc(&gc_running_threads, 1);
     ASSERT(new <= n_gc_threads);
     return new;
 }
@@ -924,7 +950,7 @@ any_work (void)
     if (mark_stack_bd != NULL && !mark_stack_empty()) {
        return rtsTrue;
     }
-    
+
     // Check for global work in any step.  We don't need to check for
     // local work, because we have already exited scavenge_loop(),
     // which means there is no local work for this thread.
@@ -955,13 +981,13 @@ any_work (void)
 #endif
 
     return rtsFalse;
-}    
+}
 
 static void
 scavenge_until_all_done (void)
 {
     DEBUG_ONLY( nat r );
-       
+
 
 loop:
 #if defined(THREADED_RTS)
@@ -987,7 +1013,7 @@ loop:
     traceEventGcIdle(gct->cap);
 
     debugTrace(DEBUG_gc, "%d GC threads still running", r);
-    
+
     while (gc_running_threads != 0) {
         // usleep(1);
         if (any_work()) {
@@ -997,10 +1023,10 @@ loop:
         }
         // any_work() does not remove the work from the queue, it
         // just checks for the presence of work.  If we find any,
-        // then we increment gc_running_threads and go back to 
+        // then we increment gc_running_threads and go back to
         // scavenge_loop() to perform any pending work.
     }
-    
+
     traceEventGcDone(gct->cap);
 }
 
@@ -1014,17 +1040,22 @@ gcWorkerThread (Capability *cap)
     // necessary if we stole a callee-saves register for gct:
     saved_gct = gct;
 
-    gct = gc_threads[cap->no];
+    SET_GCT(gc_threads[cap->no]);
     gct->id = osThreadId();
 
     stat_gcWorkerThreadStart(gct);
 
     // Wait until we're told to wake up
     RELEASE_SPIN_LOCK(&gct->mut_spin);
+    // yieldThread();
+    //    Strangely, adding a yieldThread() here makes the CPU time
+    //    measurements more accurate on Linux, perhaps because it syncs
+    //    the CPU time across the multiple cores.  Without this, CPU time
+    //    is heavily skewed towards GC rather than MUT.
     gct->wakeup = GC_THREAD_STANDING_BY;
     debugTrace(DEBUG_gc, "GC thread %d standing by...", gct->thread_index);
     ACQUIRE_SPIN_LOCK(&gct->gc_spin);
-    
+
 #ifdef USE_PAPI
     // start performance counters in this thread...
     if (gct->papi_events == -1) {
@@ -1043,7 +1074,11 @@ gcWorkerThread (Capability *cap)
     scavenge_capability_mut_lists(cap);
 
     scavenge_until_all_done();
-    
+
+    if (!DEBUG_IS_ON) {
+        clearNursery(cap);
+    }
+
 #ifdef THREADED_RTS
     // Now that the whole heap is marked, we discard any sparks that
     // were found to be unreachable.  The main GC thread is currently
@@ -1062,7 +1097,7 @@ gcWorkerThread (Capability *cap)
     // Wait until we're told to continue
     RELEASE_SPIN_LOCK(&gct->gc_spin);
     gct->wakeup = GC_THREAD_WAITING_TO_CONTINUE;
-    debugTrace(DEBUG_gc, "GC thread %d waiting to continue...", 
+    debugTrace(DEBUG_gc, "GC thread %d waiting to continue...",
                gct->thread_index);
     ACQUIRE_SPIN_LOCK(&gct->mut_spin);
     debugTrace(DEBUG_gc, "GC thread %d on my way...", gct->thread_index);
@@ -1080,14 +1115,14 @@ gcWorkerThread (Capability *cap)
 void
 waitForGcThreads (Capability *cap USED_IF_THREADS)
 {
-    const nat n_threads = RtsFlags.ParFlags.nNodes;
+    const nat n_threads = n_capabilities;
     const nat me = cap->no;
     nat i, j;
     rtsBool retry = rtsTrue;
 
     while(retry) {
         for (i=0; i < n_threads; i++) {
-            if (i == me) continue;
+            if (i == me || gc_threads[i]->idle) continue;
             if (gc_threads[i]->wakeup != GC_THREAD_STANDING_BY) {
                 prodCapability(&capabilities[i], cap->running_task);
             }
@@ -1095,9 +1130,9 @@ waitForGcThreads (Capability *cap USED_IF_THREADS)
         for (j=0; j < 10; j++) {
             retry = rtsFalse;
             for (i=0; i < n_threads; i++) {
-                if (i == me) continue;
+                if (i == me || gc_threads[i]->idle) continue;
                 write_barrier();
-                setContextSwitches();
+                interruptCapability(&capabilities[i]);
                 if (gc_threads[i]->wakeup != GC_THREAD_STANDING_BY) {
                     retry = rtsTrue;
                 }
@@ -1127,8 +1162,8 @@ wakeup_gc_threads (nat me USED_IF_THREADS)
     if (n_gc_threads == 1) return;
 
     for (i=0; i < n_gc_threads; i++) {
-        if (i == me) continue;
-       inc_running();
+        if (i == me || gc_threads[i]->idle) continue;
+        inc_running();
         debugTrace(DEBUG_gc, "waking up gc thread %d", i);
         if (gc_threads[i]->wakeup != GC_THREAD_STANDING_BY) barf("wakeup_gc_threads");
 
@@ -1151,7 +1186,7 @@ shutdown_gc_threads (nat me USED_IF_THREADS)
     if (n_gc_threads == 1) return;
 
     for (i=0; i < n_gc_threads; i++) {
-        if (i == me) continue;
+        if (i == me || gc_threads[i]->idle) continue;
         while (gc_threads[i]->wakeup != GC_THREAD_WAITING_TO_CONTINUE) { write_barrier(); }
     }
 #endif
@@ -1161,14 +1196,14 @@ shutdown_gc_threads (nat me USED_IF_THREADS)
 void
 releaseGCThreads (Capability *cap USED_IF_THREADS)
 {
-    const nat n_threads = RtsFlags.ParFlags.nNodes;
+    const nat n_threads = n_capabilities;
     const nat me = cap->no;
     nat i;
     for (i=0; i < n_threads; i++) {
-        if (i == me) continue;
-        if (gc_threads[i]->wakeup != GC_THREAD_WAITING_TO_CONTINUE) 
+        if (i == me || gc_threads[i]->idle) continue;
+        if (gc_threads[i]->wakeup != GC_THREAD_WAITING_TO_CONTINUE)
             barf("releaseGCThreads");
-        
+
         gc_threads[i]->wakeup = GC_THREAD_INACTIVE;
         ACQUIRE_SPIN_LOCK(&gc_threads[i]->gc_spin);
         RELEASE_SPIN_LOCK(&gc_threads[i]->mut_spin);
@@ -1177,7 +1212,7 @@ releaseGCThreads (Capability *cap USED_IF_THREADS)
 #endif
 
 /* ----------------------------------------------------------------------------
-   Initialise a generation that is to be collected 
+   Initialise a generation that is to be collected
    ------------------------------------------------------------------------- */
 
 static void
@@ -1248,7 +1283,7 @@ prepare_collected_gen (generation *gen)
     for (bd = gen->old_blocks; bd; bd = bd->link) {
         bd->flags &= ~BF_EVACUATED;
     }
-    
+
     // mark the large objects as from-space
     for (bd = gen->large_objects; bd; bd = bd->link) {
         bd->flags &= ~BF_EVACUATED;
@@ -1256,30 +1291,30 @@ prepare_collected_gen (generation *gen)
 
     // for a compacted generation, we need to allocate the bitmap
     if (gen->mark) {
-        lnat bitmap_size; // in bytes
+        StgWord bitmap_size; // in bytes
         bdescr *bitmap_bdescr;
         StgWord *bitmap;
-       
+
         bitmap_size = gen->n_old_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
-       
+
         if (bitmap_size > 0) {
-            bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) 
+            bitmap_bdescr = allocGroup((StgWord)BLOCK_ROUND_UP(bitmap_size)
                                        / BLOCK_SIZE);
             gen->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=gen->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_MARKED flag
                 // for this block.  The invariant is that
                 // BF_MARKED is always unset, except during GC
@@ -1310,7 +1345,7 @@ stash_mut_list (Capability *cap, nat gen_no)
 }
 
 /* ----------------------------------------------------------------------------
-   Initialise a generation that is *not* to be collected 
+   Initialise a generation that is *not* to be collected
    ------------------------------------------------------------------------- */
 
 static void
@@ -1343,10 +1378,10 @@ collect_gct_blocks (void)
     nat g;
     gen_workspace *ws;
     bdescr *bd, *prev;
-    
+
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         ws = &gct->gens[g];
-        
+
         // there may still be a block attached to ws->todo_bd;
         // leave it there to use next time.
 
@@ -1355,7 +1390,7 @@ collect_gct_blocks (void)
 
             ASSERT(gct->scan_bd == NULL);
             ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks);
-        
+
             prev = NULL;
             for (bd = ws->scavd_list; bd != NULL; bd = bd->link) {
                 ws->gen->n_words += bd->free - bd->start;
@@ -1364,7 +1399,7 @@ collect_gct_blocks (void)
             if (prev != NULL) {
                 prev->link = ws->gen->blocks;
                 ws->gen->blocks = ws->scavd_list;
-            } 
+            }
             ws->gen->n_blocks += ws->n_scavd_blocks;
 
             ws->scavd_list = NULL;
@@ -1376,6 +1411,39 @@ collect_gct_blocks (void)
 }
 
 /* -----------------------------------------------------------------------------
+   During mutation, any blocks that are filled by allocatePinned() are
+   stashed on the local pinned_object_blocks list, to avoid needing to
+   take a global lock.  Here we collect those blocks from the
+   cap->pinned_object_blocks lists and put them on the
+   main g0->large_object list.
+
+   Returns: the number of words allocated this way, for stats
+   purposes.
+   -------------------------------------------------------------------------- */
+
+static void
+collect_pinned_object_blocks (void)
+{
+    nat n;
+    bdescr *bd, *prev;
+
+    for (n = 0; n < n_capabilities; n++) {
+        prev = NULL;
+        for (bd = capabilities[n].pinned_object_blocks; bd != NULL; bd = bd->link) {
+            prev = bd;
+        }
+        if (prev != NULL) {
+            prev->link = g0->large_objects;
+            if (g0->large_objects != NULL) {
+                g0->large_objects->u.back = prev;
+            }
+            g0->large_objects = capabilities[n].pinned_object_blocks;
+            capabilities[n].pinned_object_blocks = 0;
+        }
+    }
+}
+
+/* -----------------------------------------------------------------------------
    Initialise a gc_thread before GC
    -------------------------------------------------------------------------- */
 
@@ -1414,9 +1482,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root)
     saved_gct = gct;
 #endif
     SET_GCT(user);
-    
+
     evacuate(root);
-    
+
     SET_GCT(saved_gct);
 }
 
@@ -1441,7 +1509,7 @@ zero_static_object_list(StgClosure* first_static)
 /* ----------------------------------------------------------------------------
    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.
@@ -1453,10 +1521,10 @@ resize_generations (void)
     nat g;
 
     if (major_gc && RtsFlags.GcFlags.generations > 1) {
-       nat live, size, min_alloc, words;
-       const nat max  = RtsFlags.GcFlags.maxHeapSize;
-       const nat gens = RtsFlags.GcFlags.generations;
-       
+        W_ live, size, min_alloc, words;
+        const W_ max  = RtsFlags.GcFlags.maxHeapSize;
+        const W_ gens = RtsFlags.GcFlags.generations;
+
        // live in the oldest generations
         if (oldest_gen->live_estimate != 0) {
             words = oldest_gen->live_estimate;
@@ -1465,13 +1533,17 @@ resize_generations (void)
         }
         live = (words + BLOCK_SIZE_W - 1) / BLOCK_SIZE_W +
             oldest_gen->n_large_blocks;
-       
+
        // default max size for all generations except zero
        size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
                       RtsFlags.GcFlags.minOldGenSize);
-       
+
         if (RtsFlags.GcFlags.heapSizeSuggestionAuto) {
-            RtsFlags.GcFlags.heapSizeSuggestion = size;
+            if (max > 0) {
+                RtsFlags.GcFlags.heapSizeSuggestion = stg_min(max, size);
+            } else {
+                RtsFlags.GcFlags.heapSizeSuggestion = size;
+            }
         }
 
        // minimum size for generation zero
@@ -1482,7 +1554,7 @@ resize_generations (void)
        // certain percentage of the maximum heap size (default: 30%).
        if (RtsFlags.GcFlags.compact ||
             (max > 0 &&
-             oldest_gen->n_blocks > 
+             oldest_gen->n_blocks >
              (RtsFlags.GcFlags.compactThreshold * max) / 100)) {
            oldest_gen->mark = 1;
            oldest_gen->compact = 1;
@@ -1502,14 +1574,14 @@ resize_generations (void)
        // 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->compact) {
                if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
                    size = (max - min_alloc) / ((gens - 1) * 2 - 1);
@@ -1519,17 +1591,17 @@ resize_generations (void)
                    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;
        }
@@ -1543,12 +1615,12 @@ resize_generations (void)
 static void
 resize_nursery (void)
 {
-    const lnat min_nursery = RtsFlags.GcFlags.minAllocAreaSize * n_capabilities;
+    const StgWord min_nursery = RtsFlags.GcFlags.minAllocAreaSize * n_capabilities;
 
     if (RtsFlags.GcFlags.generations == 1)
     {   // Two-space collector:
-       nat blocks;
-    
+        W_ 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
@@ -1558,25 +1630,25 @@ resize_nursery (void)
         * 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 = generations[0].n_blocks;
-       
+
        if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
-            blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
+            blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
             RtsFlags.GcFlags.maxHeapSize )
        {
-           long adjusted_blocks;  // signed on purpose 
-           int pc_free; 
-           
+           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", 
+
+           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 */
            {
@@ -1596,15 +1668,17 @@ resize_nursery (void)
     }
     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;
-           const nat needed = calcNeeded();    // approx blocks needed at next GC 
-           
+            StgWord needed;
+
+            calcNeeded(rtsFalse, &needed); // 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 g0 that was live at the last minor GC.
@@ -1619,28 +1693,28 @@ resize_nursery (void)
                g0_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 + g0_pcnt_kept/100
             *
             * where 'needed' is the amount of memory needed at the next
             * collection for collecting all gens except g0.
             */
-           blocks = 
+           blocks =
                (((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
                (100 + (long)g0_pcnt_kept);
-           
+
            if (blocks < (long)min_nursery) {
                blocks = min_nursery;
            }
-           
-           resizeNurseries((nat)blocks);
+
+            resizeNurseries((W_)blocks);
        }
        else
        {
@@ -1660,7 +1734,7 @@ resize_nursery (void)
    whenever the program tries to enter a garbage collected CAF.
 
    Any garbage collected CAFs are taken off the CAF list at the same
-   time. 
+   time.
    -------------------------------------------------------------------------- */
 
 #if 0 && defined(DEBUG)
@@ -1678,14 +1752,14 @@ gcCAFs(void)
   pp = &caf_list;
 
   while (p != NULL) {
-    
+
     info = get_itbl(p);
 
     ASSERT(info->type == IND_STATIC);
 
     if (STATIC_LINK(info,p) == NULL) {
        debugTrace(DEBUG_gccafs, "CAF gc'd at 0x%04lx", (long)p);
-       // black hole it 
+       // black hole it
        SET_INFO(p,&stg_BLACKHOLE_info);
        p = STATIC_LINK2(info,p);
        *pp = p;
@@ -1698,6 +1772,6 @@ gcCAFs(void)
 
   }
 
-  debugTrace(DEBUG_gccafs, "%d CAFs live", i); 
+  debugTrace(DEBUG_gccafs, "%d CAFs live", i);
 }
 #endif