rts/sm/GC.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2008
   4  *
   5  * Generational garbage collector
   6  *
   7  * Documentation on the architecture of the Garbage Collector can be
   8  * found in the online commentary:
   9  *
  10  *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  11  *
  12  * ---------------------------------------------------------------------------*/
  13
  14 #include "PosixSource.h"
  15 #include "Rts.h"
  16 #include "HsFFI.h"
  17
  18 #include "Storage.h"
  19 #include "RtsUtils.h"
  20 #include "Apply.h"
  21 #include "Updates.h"
  22 #include "Stats.h"
  23 #include "Schedule.h"
  24 #include "Sanity.h"
  25 #include "BlockAlloc.h"
  26 #include "ProfHeap.h"
  27 #include "Weak.h"
  28 #include "Prelude.h"
  29 #include "RtsSignals.h"
  30 #include "STM.h"
  31 #if defined(RTS_GTK_FRONTPANEL)
  32 #include "FrontPanel.h"
  33 #endif
  34 #include "Trace.h"
  35 #include "RetainerProfile.h"
  36 #include "LdvProfile.h"
  37 #include "RaiseAsync.h"
  38 #include "Papi.h"
  39 #include "Stable.h"
  40
  41 #include "GC.h"
  42 #include "GCThread.h"
  43 #include "Compact.h"
  44 #include "Evac.h"
  45 #include "Scav.h"
  46 #include "GCUtils.h"
  47 #include "MarkStack.h"
  48 #include "MarkWeak.h"
  49 #include "Sparks.h"
  50 #include "Sweep.h"
  51
  52 #include <string.h> // for memset()
  53 #include <unistd.h>
  54
  55 /* -----------------------------------------------------------------------------
  56    Global variables
  57    -------------------------------------------------------------------------- */
  58
  59 /* STATIC OBJECT LIST.
  60  *
  61  * During GC:
  62  * We maintain a linked list of static objects that are still live.
  63  * The requirements for this list are:
  64  *
  65  *  - we need to scan the list while adding to it, in order to
  66  *    scavenge all the static objects (in the same way that
  67  *    breadth-first scavenging works for dynamic objects).
  68  *
  69  *  - we need to be able to tell whether an object is already on
  70  *    the list, to break loops.
  71  *
  72  * Each static object has a "static link field", which we use for
  73  * linking objects on to the list.  We use a stack-type list, consing
  74  * objects on the front as they are added (this means that the
  75  * scavenge phase is depth-first, not breadth-first, but that
  76  * shouldn't matter).
  77  *
  78  * A separate list is kept for objects that have been scavenged
  79  * already - this is so that we can zero all the marks afterwards.
  80  *
  81  * An object is on the list if its static link field is non-zero; this
  82  * means that we have to mark the end of the list with '1', not NULL.
  83  *
  84  * Extra notes for generational GC:
  85  *
  86  * Each generation has a static object list associated with it.  When
  87  * collecting generations up to N, we treat the static object lists
  88  * from generations > N as roots.
  89  *
  90  * We build up a static object list while collecting generations 0..N,
  91  * which is then appended to the static object list of generation N+1.
  92  */
  93
  94 /* N is the oldest generation being collected, where the generations
  95  * are numbered starting at 0.  A major GC (indicated by the major_gc
  96  * flag) is when we're collecting all generations.  We only attempt to
  97  * deal with static objects and GC CAFs when doing a major GC.
  98  */
  99 nat N;
 100 rtsBool major_gc;
 101
 102 /* Data used for allocation area sizing.
 103  */
 104 static lnat g0_pcnt_kept = 30; // percentage of g0 live at last minor GC
 105
 106 /* Mut-list stats */
 107 #ifdef DEBUG
 108 nat mutlist_MUTVARS,
 109     mutlist_MUTARRS,
 110     mutlist_MVARS,
 111     mutlist_OTHERS;
 112 #endif
 113
 114 /* Thread-local data for each GC thread
 115  */
 116 gc_thread **gc_threads = NULL;
 117
 118 #if !defined(THREADED_RTS)
 119 StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)];
 120 #endif
 121
 122 // Number of threads running in *this* GC.  Affects how many
 123 // step->todos[] lists we have to look in to find work.
 124 nat n_gc_threads;
 125
 126 // For stats:
 127 long copied;        // *words* copied & scavenged during this GC
 128
 129 rtsBool work_stealing;
 130
 131 DECLARE_GCT
 132
 133 /* -----------------------------------------------------------------------------
 134    Static function declarations
 135    -------------------------------------------------------------------------- */
 136
 137 static void mark_root               (void *user, StgClosure **root);
 138 static void zero_static_object_list (StgClosure* first_static);
 139 static nat  initialise_N            (rtsBool force_major_gc);
 140 static void init_collected_gen      (nat g, nat threads);
 141 static void init_uncollected_gen    (nat g, nat threads);
 142 static void init_gc_thread          (gc_thread *t);
 143 static void resize_generations      (void);
 144 static void resize_nursery          (void);
 145 static void start_gc_threads        (void);
 146 static void scavenge_until_all_done (void);
 147 static StgWord inc_running          (void);
 148 static StgWord dec_running          (void);
 149 static void wakeup_gc_threads       (nat n_threads, nat me);
 150 static void shutdown_gc_threads     (nat n_threads, nat me);
 151
 152 #if 0 && defined(DEBUG)
 153 static void gcCAFs                  (void);
 154 #endif
 155
 156 /* -----------------------------------------------------------------------------
 157    The mark stack.
 158    -------------------------------------------------------------------------- */
 159
 160 bdescr *mark_stack_top_bd; // topmost block in the mark stack
 161 bdescr *mark_stack_bd;     // current block in the mark stack
 162 StgPtr mark_sp;            // pointer to the next unallocated mark stack entry
 163
 164 /* -----------------------------------------------------------------------------
 165    GarbageCollect: the main entry point to the garbage collector.
 166
 167    Locks held: all capabilities are held throughout GarbageCollect().
 168    -------------------------------------------------------------------------- */
 169
 170 void
 171 GarbageCollect (rtsBool force_major_gc,
 172                 nat gc_type USED_IF_THREADS,
 173                 Capability *cap)
 174 {
 175   bdescr *bd;
 176   generation *gen;
 177   lnat live, allocated, max_copied, avg_copied, slop;
 178   gc_thread *saved_gct;
 179   nat g, t, n;
 180
 181   // necessary if we stole a callee-saves register for gct:
 182   saved_gct = gct;
 183
 184 #ifdef PROFILING
 185   CostCentreStack *prev_CCS;
 186 #endif
 187
 188   ACQUIRE_SM_LOCK;
 189
 190 #if defined(RTS_USER_SIGNALS)
 191   if (RtsFlags.MiscFlags.install_signal_handlers) {
 192     // block signals
 193     blockUserSignals();
 194   }
 195 #endif
 196
 197   ASSERT(sizeof(gen_workspace) == 16 * sizeof(StgWord));
 198   // otherwise adjust the padding in gen_workspace.
 199
 200   // tell the stats department that we've started a GC
 201   stat_startGC();
 202
 203   // tell the STM to discard any cached closures it's hoping to re-use
 204   stmPreGCHook();
 205
 206   // lock the StablePtr table
 207   stablePtrPreGC();
 208
 209 #ifdef DEBUG
 210   mutlist_MUTVARS = 0;
 211   mutlist_MUTARRS = 0;
 212   mutlist_OTHERS = 0;
 213 #endif
 214
 215   // attribute any costs to CCS_GC
 216 #ifdef PROFILING
 217   prev_CCS = CCCS;
 218   CCCS = CCS_GC;
 219 #endif
 220
 221   /* Approximate how much we allocated.
 222    * Todo: only when generating stats?
 223    */
 224   allocated = calcAllocated();
 225
 226   /* Figure out which generation to collect
 227    */
 228   n = initialise_N(force_major_gc);
 229
 230 #if defined(THREADED_RTS)
 231   work_stealing = RtsFlags.ParFlags.parGcLoadBalancingEnabled &&
 232                   N >= RtsFlags.ParFlags.parGcLoadBalancingGen;
 233       // It's not always a good idea to do load balancing in parallel
 234       // GC.  In particular, for a parallel program we don't want to
 235       // lose locality by moving cached data into another CPU's cache
 236       // (this effect can be quite significant).
 237       //
 238       // We could have a more complex way to deterimine whether to do
 239       // work stealing or not, e.g. it might be a good idea to do it
 240       // if the heap is big.  For now, we just turn it on or off with
 241       // a flag.
 242 #endif
 243
 244   /* Start threads, so they can be spinning up while we finish initialisation.
 245    */
 246   start_gc_threads();
 247
 248 #if defined(THREADED_RTS)
 249   /* How many threads will be participating in this GC?
 250    * We don't try to parallelise minor GCs (unless the user asks for
 251    * it with +RTS -gn0), or mark/compact/sweep GC.
 252    */
 253   if (gc_type == PENDING_GC_PAR) {
 254       n_gc_threads = RtsFlags.ParFlags.nNodes;
 255   } else {
 256       n_gc_threads = 1;
 257   }
 258 #else
 259   n_gc_threads = 1;
 260 #endif
 261
 262   debugTrace(DEBUG_gc, "GC (gen %d): %d KB to collect, %ld MB in use, using %d thread(s)",
 263         N, n * (BLOCK_SIZE / 1024), mblocks_allocated, n_gc_threads);
 264
 265 #ifdef RTS_GTK_FRONTPANEL
 266   if (RtsFlags.GcFlags.frontpanel) {
 267       updateFrontPanelBeforeGC(N);
 268   }
 269 #endif
 270
 271 #ifdef DEBUG
 272   // check for memory leaks if DEBUG is on
 273   memInventory(DEBUG_gc);
 274 #endif
 275
 276   // check sanity *before* GC
 277   IF_DEBUG(sanity, checkSanity(rtsTrue));
 278
 279   // Initialise all our gc_thread structures
 280   for (t = 0; t < n_gc_threads; t++) {
 281       init_gc_thread(gc_threads[t]);
 282   }
 283
 284   // Initialise all the generations/steps that we're collecting.
 285   for (g = 0; g <= N; g++) {
 286       init_collected_gen(g,n_gc_threads);
 287   }
 288
 289   // Initialise all the generations/steps that we're *not* collecting.
 290   for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
 291       init_uncollected_gen(g,n_gc_threads);
 292   }
 293
 294   /* Allocate a mark stack if we're doing a major collection.
 295    */
 296   if (major_gc && oldest_gen->mark) {
 297       mark_stack_bd     = allocBlock();
 298       mark_stack_top_bd = mark_stack_bd;
 299       mark_stack_bd->link = NULL;
 300       mark_stack_bd->u.back = NULL;
 301       mark_sp           = mark_stack_bd->start;
 302   } else {
 303       mark_stack_bd     = NULL;
 304       mark_stack_top_bd = NULL;
 305       mark_sp           = NULL;
 306   }
 307
 308   // this is the main thread
 309 #ifdef THREADED_RTS
 310   if (n_gc_threads == 1) {
 311       SET_GCT(gc_threads[0]);
 312   } else {
 313       SET_GCT(gc_threads[cap->no]);
 314   }
 315 #else
 316 SET_GCT(gc_threads[0]);
 317 #endif
 318
 319   /* -----------------------------------------------------------------------
 320    * follow all the roots that we know about:
 321    */
 322
 323   // the main thread is running: this prevents any other threads from
 324   // exiting prematurely, so we can start them now.
 325   // NB. do this after the mutable lists have been saved above, otherwise
 326   // the other GC threads will be writing into the old mutable lists.
 327   inc_running();
 328   wakeup_gc_threads(n_gc_threads, gct->thread_index);
 329
 330   // Mutable lists from each generation > N
 331   // we want to *scavenge* these roots, not evacuate them: they're not
 332   // going to move in this GC.
 333   // Also do them in reverse generation order, for the usual reason:
 334   // namely to reduce the likelihood of spurious old->new pointers.
 335   //
 336   for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
 337 #if defined(THREADED_RTS)
 338       if (n_gc_threads > 1) {
 339           scavenge_mutable_list(generations[g].saved_mut_list, &generations[g]);
 340       } else {
 341           scavenge_mutable_list1(generations[g].saved_mut_list, &generations[g]);
 342       }
 343 #else
 344       scavenge_mutable_list(generations[g].saved_mut_list, &generations[g]);
 345 #endif
 346       freeChain_sync(generations[g].saved_mut_list);
 347       generations[g].saved_mut_list = NULL;
 348
 349   }
 350
 351   // scavenge the capability-private mutable lists.  This isn't part
 352   // of markSomeCapabilities() because markSomeCapabilities() can only
 353   // call back into the GC via mark_root() (due to the gct register
 354   // variable).
 355   if (n_gc_threads == 1) {
 356       for (n = 0; n < n_capabilities; n++) {
 357 #if defined(THREADED_RTS)
 358           scavenge_capability_mut_Lists1(&capabilities[n]);
 359 #else
 360           scavenge_capability_mut_lists(&capabilities[n]);
 361 #endif
 362       }
 363   } else {
 364       scavenge_capability_mut_lists(&capabilities[gct->thread_index]);
 365   }
 366
 367   // follow roots from the CAF list (used by GHCi)
 368   gct->evac_gen = 0;
 369   markCAFs(mark_root, gct);
 370
 371   // follow all the roots that the application knows about.
 372   gct->evac_gen = 0;
 373   markSomeCapabilities(mark_root, gct, gct->thread_index, n_gc_threads,
 374                        rtsTrue/*prune sparks*/);
 375
 376 #if defined(RTS_USER_SIGNALS)
 377   // mark the signal handlers (signals should be already blocked)
 378   markSignalHandlers(mark_root, gct);
 379 #endif
 380
 381   // Mark the weak pointer list, and prepare to detect dead weak pointers.
 382   markWeakPtrList();
 383   initWeakForGC();
 384
 385   // Mark the stable pointer table.
 386   markStablePtrTable(mark_root, gct);
 387
 388   /* -------------------------------------------------------------------------
 389    * Repeatedly scavenge all the areas we know about until there's no
 390    * more scavenging to be done.
 391    */
 392   for (;;)
 393   {
 394       scavenge_until_all_done();
 395       // The other threads are now stopped.  We might recurse back to
 396       // here, but from now on this is the only thread.
 397
 398       // if any blackholes are alive, make the threads that wait on
 399       // them alive too.
 400       if (traverseBlackholeQueue()) {
 401           inc_running();
 402           continue;
 403       }
 404
 405       // must be last...  invariant is that everything is fully
 406       // scavenged at this point.
 407       if (traverseWeakPtrList()) { // returns rtsTrue if evaced something
 408           inc_running();
 409           continue;
 410       }
 411
 412       // If we get to here, there's really nothing left to do.
 413       break;
 414   }
 415
 416   shutdown_gc_threads(n_gc_threads, gct->thread_index);
 417
 418   // Now see which stable names are still alive.
 419   gcStablePtrTable();
 420
 421 #ifdef PROFILING
 422   // We call processHeapClosureForDead() on every closure destroyed during
 423   // the current garbage collection, so we invoke LdvCensusForDead().
 424   if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
 425       || RtsFlags.ProfFlags.bioSelector != NULL)
 426     LdvCensusForDead(N);
 427 #endif
 428
 429   // NO MORE EVACUATION AFTER THIS POINT!
 430
 431   // Two-space collector: free the old to-space.
 432   // g0->old_blocks is the old nursery
 433   // g0->blocks is to-space from the previous GC
 434   if (RtsFlags.GcFlags.generations == 1) {
 435       if (g0->blocks != NULL) {
 436           freeChain(g0->blocks);
 437           g0->blocks = NULL;
 438       }
 439   }
 440
 441   // For each workspace, in each thread, move the copied blocks to the step
 442   {
 443       gc_thread *thr;
 444       gen_workspace *ws;
 445       bdescr *prev, *next;
 446
 447       for (t = 0; t < n_gc_threads; t++) {
 448           thr = gc_threads[t];
 449
 450           for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 451               ws = &thr->gens[g];
 452
 453               // Push the final block
 454               if (ws->todo_bd) {
 455                   push_scanned_block(ws->todo_bd, ws);
 456               }
 457
 458               ASSERT(gct->scan_bd == NULL);
 459               ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks);
 460
 461               prev = NULL;
 462               for (bd = ws->scavd_list; bd != NULL; bd = bd->link) {
 463                   ws->gen->n_words += bd->free - bd->start;
 464                   prev = bd;
 465               }
 466               if (prev != NULL) {
 467                   prev->link = ws->gen->blocks;
 468                   ws->gen->blocks = ws->scavd_list;
 469               }
 470               ws->gen->n_blocks += ws->n_scavd_blocks;
 471           }
 472       }
 473
 474       // Add all the partial blocks *after* we've added all the full
 475       // blocks.  This is so that we can grab the partial blocks back
 476       // again and try to fill them up in the next GC.
 477       for (t = 0; t < n_gc_threads; t++) {
 478           thr = gc_threads[t];
 479
 480           for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 481               ws = &thr->gens[g];
 482
 483               prev = NULL;
 484               for (bd = ws->part_list; bd != NULL; bd = next) {
 485                   next = bd->link;
 486                   if (bd->free == bd->start) {
 487                       if (prev == NULL) {
 488                           ws->part_list = next;
 489                       } else {
 490                           prev->link = next;
 491                       }
 492                       freeGroup(bd);
 493                       ws->n_part_blocks--;
 494                   } else {
 495                       ws->gen->n_words += bd->free - bd->start;
 496                       prev = bd;
 497                   }
 498               }
 499               if (prev != NULL) {
 500                   prev->link = ws->gen->blocks;
 501                   ws->gen->blocks = ws->part_list;
 502               }
 503               ws->gen->n_blocks += ws->n_part_blocks;
 504
 505               ASSERT(countBlocks(ws->gen->blocks) == ws->gen->n_blocks);
 506               ASSERT(countOccupied(ws->gen->blocks) == ws->gen->n_words);
 507           }
 508       }
 509   }
 510
 511   // Finally: compact or sweep the oldest generation.
 512   if (major_gc && oldest_gen->mark) {
 513       if (oldest_gen->compact)
 514           compact(gct->scavenged_static_objects);
 515       else
 516           sweep(oldest_gen);
 517   }
 518
 519   /* run through all the generations/steps and tidy up
 520    */
 521   copied = 0;
 522   max_copied = 0;
 523   avg_copied = 0;
 524   {
 525       nat i;
 526       for (i=0; i < n_gc_threads; i++) {
 527           if (n_gc_threads > 1) {
 528               debugTrace(DEBUG_gc,"thread %d:", i);
 529               debugTrace(DEBUG_gc,"   copied           %ld", gc_threads[i]->copied * sizeof(W_));
 530               debugTrace(DEBUG_gc,"   scanned          %ld", gc_threads[i]->scanned * sizeof(W_));
 531               debugTrace(DEBUG_gc,"   any_work         %ld", gc_threads[i]->any_work);
 532               debugTrace(DEBUG_gc,"   no_work          %ld", gc_threads[i]->no_work);
 533               debugTrace(DEBUG_gc,"   scav_find_work %ld",   gc_threads[i]->scav_find_work);
 534           }
 535           copied += gc_threads[i]->copied;
 536           max_copied = stg_max(gc_threads[i]->copied, max_copied);
 537       }
 538       if (n_gc_threads == 1) {
 539           max_copied = 0;
 540           avg_copied = 0;
 541       } else {
 542           avg_copied = copied;
 543       }
 544   }
 545
 546   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 547
 548     if (g == N) {
 549       generations[g].collections++; // for stats
 550       if (n_gc_threads > 1) generations[g].par_collections++;
 551     }
 552
 553     // Count the mutable list as bytes "copied" for the purposes of
 554     // stats.  Every mutable list is copied during every GC.
 555     if (g > 0) {
 556         nat mut_list_size = 0;
 557         for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
 558             mut_list_size += bd->free - bd->start;
 559         }
 560         for (n = 0; n < n_capabilities; n++) {
 561             for (bd = capabilities[n].mut_lists[g];
 562                  bd != NULL; bd = bd->link) {
 563                 mut_list_size += bd->free - bd->start;
 564             }
 565         }
 566         copied +=  mut_list_size;
 567
 568         debugTrace(DEBUG_gc,
 569                    "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d others)",
 570                    (unsigned long)(mut_list_size * sizeof(W_)),
 571                    mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS, mutlist_OTHERS);
 572     }
 573
 574     bdescr *next, *prev;
 575     gen = &generations[g];
 576
 577     // for generations we collected...
 578     if (g <= N) {
 579
 580         /* free old memory and shift to-space into from-space for all
 581          * the collected steps (except the allocation area).  These
 582          * freed blocks will probaby be quickly recycled.
 583          */
 584         if (gen->mark)
 585         {
 586             // tack the new blocks on the end of the existing blocks
 587             if (gen->old_blocks != NULL) {
 588
 589                 prev = NULL;
 590                 for (bd = gen->old_blocks; bd != NULL; bd = next) {
 591
 592                     next = bd->link;
 593
 594                     if (!(bd->flags & BF_MARKED))
 595                     {
 596                         if (prev == NULL) {
 597                             gen->old_blocks = next;
 598                         } else {
 599                             prev->link = next;
 600                         }
 601                         freeGroup(bd);
 602                         gen->n_old_blocks--;
 603                     }
 604                     else
 605                     {
 606                         gen->n_words += bd->free - bd->start;
 607
 608                         // NB. this step might not be compacted next
 609                         // time, so reset the BF_MARKED flags.
 610                         // They are set before GC if we're going to
 611                         // compact.  (search for BF_MARKED above).
 612                         bd->flags &= ~BF_MARKED;
 613
 614                         // between GCs, all blocks in the heap except
 615                         // for the nursery have the BF_EVACUATED flag set.
 616                         bd->flags |= BF_EVACUATED;
 617
 618                         prev = bd;
 619                     }
 620                 }
 621
 622                 if (prev != NULL) {
 623                     prev->link = gen->blocks;
 624                     gen->blocks = gen->old_blocks;
 625                 }
 626             }
 627             // add the new blocks to the block tally
 628             gen->n_blocks += gen->n_old_blocks;
 629             ASSERT(countBlocks(gen->blocks) == gen->n_blocks);
 630             ASSERT(countOccupied(gen->blocks) == gen->n_words);
 631         }
 632         else // not copacted
 633         {
 634             freeChain(gen->old_blocks);
 635         }
 636
 637         gen->old_blocks = NULL;
 638         gen->n_old_blocks = 0;
 639
 640         /* LARGE OBJECTS.  The current live large objects are chained on
 641          * scavenged_large, having been moved during garbage
 642          * collection from large_objects.  Any objects left on the
 643          * large_objects list are therefore dead, so we free them here.
 644          */
 645         freeChain(gen->large_objects);
 646         gen->large_objects  = gen->scavenged_large_objects;
 647         gen->n_large_blocks = gen->n_scavenged_large_blocks;
 648         gen->n_new_large_blocks = 0;
 649         ASSERT(countBlocks(gen->large_objects) == gen->n_large_blocks);
 650     }
 651     else // for generations > N
 652     {
 653         /* For older generations, we need to append the
 654          * scavenged_large_object list (i.e. large objects that have been
 655          * promoted during this GC) to the large_object list for that step.
 656          */
 657         for (bd = gen->scavenged_large_objects; bd; bd = next) {
 658             next = bd->link;
 659             dbl_link_onto(bd, &gen->large_objects);
 660         }
 661
 662         // add the new blocks we promoted during this GC
 663         gen->n_large_blocks += gen->n_scavenged_large_blocks;
 664         ASSERT(countBlocks(gen->large_objects) == gen->n_large_blocks);
 665     }
 666   } // for all generations
 667
 668   // update the max size of older generations after a major GC
 669   resize_generations();
 670
 671   // Calculate the amount of live data for stats.
 672   live = calcLiveWords();
 673
 674   // Free the small objects allocated via allocate(), since this will
 675   // all have been copied into G0S1 now.
 676   alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
 677
 678   // Start a new pinned_object_block
 679   for (n = 0; n < n_capabilities; n++) {
 680       capabilities[n].pinned_object_block = NULL;
 681   }
 682
 683   // Free the mark stack.
 684   if (mark_stack_top_bd != NULL) {
 685       debugTrace(DEBUG_gc, "mark stack: %d blocks",
 686                  countBlocks(mark_stack_top_bd));
 687       freeChain(mark_stack_top_bd);
 688   }
 689
 690   // Free any bitmaps.
 691   for (g = 0; g <= N; g++) {
 692       gen = &generations[g];
 693       if (gen->bitmap != NULL) {
 694           freeGroup(gen->bitmap);
 695           gen->bitmap = NULL;
 696       }
 697   }
 698
 699   resize_nursery();
 700
 701  // mark the garbage collected CAFs as dead
 702 #if 0 && defined(DEBUG) // doesn't work at the moment
 703   if (major_gc) { gcCAFs(); }
 704 #endif
 705
 706 #ifdef PROFILING
 707   // resetStaticObjectForRetainerProfiling() must be called before
 708   // zeroing below.
 709   if (n_gc_threads > 1) {
 710       barf("profiling is currently broken with multi-threaded GC");
 711       // ToDo: fix the gct->scavenged_static_objects below
 712   }
 713   resetStaticObjectForRetainerProfiling(gct->scavenged_static_objects);
 714 #endif
 715
 716   // zero the scavenged static object list
 717   if (major_gc) {
 718       nat i;
 719       for (i = 0; i < n_gc_threads; i++) {
 720           zero_static_object_list(gc_threads[i]->scavenged_static_objects);
 721       }
 722   }
 723
 724   // Reset the nursery
 725   resetNurseries();
 726
 727   // start any pending finalizers
 728   RELEASE_SM_LOCK;
 729   scheduleFinalizers(cap, old_weak_ptr_list);
 730   ACQUIRE_SM_LOCK;
 731
 732   // send exceptions to any threads which were about to die
 733   RELEASE_SM_LOCK;
 734   resurrectThreads(resurrected_threads);
 735   performPendingThrowTos(exception_threads);
 736   ACQUIRE_SM_LOCK;
 737
 738   // Update the stable pointer hash table.
 739   updateStablePtrTable(major_gc);
 740
 741   // check sanity after GC
 742   IF_DEBUG(sanity, checkSanity(rtsTrue));
 743
 744   // extra GC trace info
 745   IF_DEBUG(gc, statDescribeGens());
 746
 747 #ifdef DEBUG
 748   // symbol-table based profiling
 749   /*  heapCensus(to_blocks); */ /* ToDo */
 750 #endif
 751
 752   // restore enclosing cost centre
 753 #ifdef PROFILING
 754   CCCS = prev_CCS;
 755 #endif
 756
 757 #ifdef DEBUG
 758   // check for memory leaks if DEBUG is on
 759   memInventory(DEBUG_gc);
 760 #endif
 761
 762 #ifdef RTS_GTK_FRONTPANEL
 763   if (RtsFlags.GcFlags.frontpanel) {
 764       updateFrontPanelAfterGC( N, live );
 765   }
 766 #endif
 767
 768   // ok, GC over: tell the stats department what happened.
 769   slop = calcLiveBlocks() * BLOCK_SIZE_W - live;
 770   stat_endGC(allocated, live, copied, N, max_copied, avg_copied, slop);
 771
 772   // unlock the StablePtr table
 773   stablePtrPostGC();
 774
 775   // Guess which generation we'll collect *next* time
 776   initialise_N(force_major_gc);
 777
 778 #if defined(RTS_USER_SIGNALS)
 779   if (RtsFlags.MiscFlags.install_signal_handlers) {
 780     // unblock signals again
 781     unblockUserSignals();
 782   }
 783 #endif
 784
 785   RELEASE_SM_LOCK;
 786
 787   SET_GCT(saved_gct);
 788 }
 789
 790 /* -----------------------------------------------------------------------------
 791    Figure out which generation to collect, initialise N and major_gc.
 792
 793    Also returns the total number of blocks in generations that will be
 794    collected.
 795    -------------------------------------------------------------------------- */
 796
 797 static nat
 798 initialise_N (rtsBool force_major_gc)
 799 {
 800     int g;
 801     nat blocks, blocks_total;
 802
 803     blocks = 0;
 804     blocks_total = 0;
 805
 806     if (force_major_gc) {
 807         N = RtsFlags.GcFlags.generations - 1;
 808     } else {
 809         N = 0;
 810     }
 811
 812     for (g = RtsFlags.GcFlags.generations - 1; g >= 0; g--) {
 813
 814         blocks = generations[g].n_words / BLOCK_SIZE_W
 815                + generations[g].n_large_blocks;
 816
 817         if (blocks >= generations[g].max_blocks) {
 818             N = stg_max(N,g);
 819         }
 820         if ((nat)g <= N) {
 821             blocks_total += blocks;
 822         }
 823     }
 824
 825     blocks_total += countNurseryBlocks();
 826
 827     major_gc = (N == RtsFlags.GcFlags.generations-1);
 828     return blocks_total;
 829 }
 830
 831 /* -----------------------------------------------------------------------------
 832    Initialise the gc_thread structures.
 833    -------------------------------------------------------------------------- */
 834
 835 #define GC_THREAD_INACTIVE             0
 836 #define GC_THREAD_STANDING_BY          1
 837 #define GC_THREAD_RUNNING              2
 838 #define GC_THREAD_WAITING_TO_CONTINUE  3
 839
 840 static void
 841 new_gc_thread (nat n, gc_thread *t)
 842 {
 843     nat g;
 844     gen_workspace *ws;
 845
 846 #ifdef THREADED_RTS
 847     t->id = 0;
 848     initSpinLock(&t->gc_spin);
 849     initSpinLock(&t->mut_spin);
 850     ACQUIRE_SPIN_LOCK(&t->gc_spin);
 851     t->wakeup = GC_THREAD_INACTIVE;  // starts true, so we can wait for the
 852                           // thread to start up, see wakeup_gc_threads
 853 #endif
 854
 855     t->thread_index = n;
 856     t->free_blocks = NULL;
 857     t->gc_count = 0;
 858
 859     init_gc_thread(t);
 860
 861 #ifdef USE_PAPI
 862     t->papi_events = -1;
 863 #endif
 864
 865     for (g = 0; g < RtsFlags.GcFlags.generations; g++)
 866     {
 867         ws = &t->gens[g];
 868         ws->gen = &generations[g];
 869         ASSERT(g == ws->gen->no);
 870         ws->my_gct = t;
 871
 872         ws->todo_bd = NULL;
 873         ws->todo_q = newWSDeque(128);
 874         ws->todo_overflow = NULL;
 875         ws->n_todo_overflow = 0;
 876
 877         ws->part_list = NULL;
 878         ws->n_part_blocks = 0;
 879
 880         ws->scavd_list = NULL;
 881         ws->n_scavd_blocks = 0;
 882     }
 883 }
 884
 885
 886 void
 887 initGcThreads (void)
 888 {
 889     if (gc_threads == NULL) {
 890 #if defined(THREADED_RTS)
 891         nat i;
 892         gc_threads = stgMallocBytes (RtsFlags.ParFlags.nNodes *
 893                                      sizeof(gc_thread*),
 894                                      "alloc_gc_threads");
 895
 896         for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
 897             gc_threads[i] =
 898                 stgMallocBytes(sizeof(gc_thread) +
 899                                RtsFlags.GcFlags.generations * sizeof(gen_workspace),
 900                                "alloc_gc_threads");
 901
 902             new_gc_thread(i, gc_threads[i]);
 903         }
 904 #else
 905         gc_threads = stgMallocBytes (sizeof(gc_thread*),"alloc_gc_threads");
 906         gc_threads[0] = gct;
 907         new_gc_thread(0,gc_threads[0]);
 908 #endif
 909     }
 910 }
 911
 912 void
 913 freeGcThreads (void)
 914 {
 915     nat g;
 916     if (gc_threads != NULL) {
 917 #if defined(THREADED_RTS)
 918         nat i;
 919         for (i = 0; i < n_capabilities; i++) {
 920             for (g = 0; g < RtsFlags.GcFlags.generations; g++)
 921             {
 922                 freeWSDeque(gc_threads[i]->gens[g].todo_q);
 923             }
 924             stgFree (gc_threads[i]);
 925         }
 926         stgFree (gc_threads);
 927 #else
 928         for (g = 0; g < RtsFlags.GcFlags.generations; g++)
 929         {
 930             freeWSDeque(gc_threads[0]->gens[g].todo_q);
 931         }
 932         stgFree (gc_threads);
 933 #endif
 934         gc_threads = NULL;
 935     }
 936 }
 937
 938 /* ----------------------------------------------------------------------------
 939    Start GC threads
 940    ------------------------------------------------------------------------- */
 941
 942 static volatile StgWord gc_running_threads;
 943
 944 static StgWord
 945 inc_running (void)
 946 {
 947     StgWord new;
 948     new = atomic_inc(&gc_running_threads);
 949     ASSERT(new <= n_gc_threads);
 950     return new;
 951 }
 952
 953 static StgWord
 954 dec_running (void)
 955 {
 956     ASSERT(gc_running_threads != 0);
 957     return atomic_dec(&gc_running_threads);
 958 }
 959
 960 static rtsBool
 961 any_work (void)
 962 {
 963     int g;
 964     gen_workspace *ws;
 965
 966     gct->any_work++;
 967
 968     write_barrier();
 969
 970     // scavenge objects in compacted generation
 971     if (mark_stack_bd != NULL && !mark_stack_empty()) {
 972         return rtsTrue;
 973     }
 974
 975     // Check for global work in any step.  We don't need to check for
 976     // local work, because we have already exited scavenge_loop(),
 977     // which means there is no local work for this thread.
 978     for (g = 0; g < (int)RtsFlags.GcFlags.generations; g++) {
 979         ws = &gct->gens[g];
 980         if (ws->todo_large_objects) return rtsTrue;
 981         if (!looksEmptyWSDeque(ws->todo_q)) return rtsTrue;
 982         if (ws->todo_overflow) return rtsTrue;
 983     }
 984
 985 #if defined(THREADED_RTS)
 986     if (work_stealing) {
 987         nat n;
 988         // look for work to steal
 989         for (n = 0; n < n_gc_threads; n++) {
 990             if (n == gct->thread_index) continue;
 991             for (g = RtsFlags.GcFlags.generations-1; g >= 0; g--) {
 992                 ws = &gc_threads[n]->gens[g];
 993                 if (!looksEmptyWSDeque(ws->todo_q)) return rtsTrue;
 994             }
 995         }
 996     }
 997 #endif
 998
 999     gct->no_work++;
1000
1001     return rtsFalse;
1002 }
1003
1004 static void
1005 scavenge_until_all_done (void)
1006 {
1007     nat r;
1008
1009
1010 loop:
1011     traceEvent(&capabilities[gct->thread_index], EVENT_GC_WORK);
1012
1013 #if defined(THREADED_RTS)
1014     if (n_gc_threads > 1) {
1015         scavenge_loop();
1016     } else {
1017         scavenge_loop1();
1018     }
1019 #else
1020     scavenge_loop();
1021 #endif
1022
1023     // scavenge_loop() only exits when there's no work to do
1024     r = dec_running();
1025
1026     traceEvent(&capabilities[gct->thread_index], EVENT_GC_IDLE);
1027
1028     debugTrace(DEBUG_gc, "%d GC threads still running", r);
1029
1030     while (gc_running_threads != 0) {
1031         // usleep(1);
1032         if (any_work()) {
1033             inc_running();
1034             goto loop;
1035         }
1036         // any_work() does not remove the work from the queue, it
1037         // just checks for the presence of work.  If we find any,
1038         // then we increment gc_running_threads and go back to
1039         // scavenge_loop() to perform any pending work.
1040     }
1041
1042     traceEvent(&capabilities[gct->thread_index], EVENT_GC_DONE);
1043 }
1044
1045 #if defined(THREADED_RTS)
1046
1047 void
1048 gcWorkerThread (Capability *cap)
1049 {
1050     gc_thread *saved_gct;
1051
1052     // necessary if we stole a callee-saves register for gct:
1053     saved_gct = gct;
1054
1055     gct = gc_threads[cap->no];
1056     gct->id = osThreadId();
1057
1058     // Wait until we're told to wake up
1059     RELEASE_SPIN_LOCK(&gct->mut_spin);
1060     gct->wakeup = GC_THREAD_STANDING_BY;
1061     debugTrace(DEBUG_gc, "GC thread %d standing by...", gct->thread_index);
1062     ACQUIRE_SPIN_LOCK(&gct->gc_spin);
1063
1064 #ifdef USE_PAPI
1065     // start performance counters in this thread...
1066     if (gct->papi_events == -1) {
1067         papi_init_eventset(&gct->papi_events);
1068     }
1069     papi_thread_start_gc1_count(gct->papi_events);
1070 #endif
1071
1072     // Every thread evacuates some roots.
1073     gct->evac_gen = 0;
1074     markSomeCapabilities(mark_root, gct, gct->thread_index, n_gc_threads,
1075                          rtsTrue/*prune sparks*/);
1076     scavenge_capability_mut_lists(&capabilities[gct->thread_index]);
1077
1078     scavenge_until_all_done();
1079
1080 #ifdef USE_PAPI
1081     // count events in this thread towards the GC totals
1082     papi_thread_stop_gc1_count(gct->papi_events);
1083 #endif
1084
1085     // Wait until we're told to continue
1086     RELEASE_SPIN_LOCK(&gct->gc_spin);
1087     gct->wakeup = GC_THREAD_WAITING_TO_CONTINUE;
1088     debugTrace(DEBUG_gc, "GC thread %d waiting to continue...",
1089                gct->thread_index);
1090     ACQUIRE_SPIN_LOCK(&gct->mut_spin);
1091     debugTrace(DEBUG_gc, "GC thread %d on my way...", gct->thread_index);
1092
1093     SET_GCT(saved_gct);
1094 }
1095
1096 #endif
1097
1098 #if defined(THREADED_RTS)
1099
1100 void
1101 waitForGcThreads (Capability *cap USED_IF_THREADS)
1102 {
1103     nat n_threads = RtsFlags.ParFlags.nNodes;
1104     nat me = cap->no;
1105     nat i, j;
1106     rtsBool retry = rtsTrue;
1107
1108     while(retry) {
1109         for (i=0; i < n_threads; i++) {
1110             if (i == me) continue;
1111             if (gc_threads[i]->wakeup != GC_THREAD_STANDING_BY) {
1112                 prodCapability(&capabilities[i], cap->running_task);
1113             }
1114         }
1115         for (j=0; j < 10; j++) {
1116             retry = rtsFalse;
1117             for (i=0; i < n_threads; i++) {
1118                 if (i == me) continue;
1119                 write_barrier();
1120                 setContextSwitches();
1121                 if (gc_threads[i]->wakeup != GC_THREAD_STANDING_BY) {
1122                     retry = rtsTrue;
1123                 }
1124             }
1125             if (!retry) break;
1126             yieldThread();
1127         }
1128     }
1129 }
1130
1131 #endif // THREADED_RTS
1132
1133 static void
1134 start_gc_threads (void)
1135 {
1136 #if defined(THREADED_RTS)
1137     gc_running_threads = 0;
1138 #endif
1139 }
1140
1141 static void
1142 wakeup_gc_threads (nat n_threads USED_IF_THREADS, nat me USED_IF_THREADS)
1143 {
1144 #if defined(THREADED_RTS)
1145     nat i;
1146     for (i=0; i < n_threads; i++) {
1147         if (i == me) continue;
1148         inc_running();
1149         debugTrace(DEBUG_gc, "waking up gc thread %d", i);
1150         if (gc_threads[i]->wakeup != GC_THREAD_STANDING_BY) barf("wakeup_gc_threads");
1151
1152         gc_threads[i]->wakeup = GC_THREAD_RUNNING;
1153         ACQUIRE_SPIN_LOCK(&gc_threads[i]->mut_spin);
1154         RELEASE_SPIN_LOCK(&gc_threads[i]->gc_spin);
1155     }
1156 #endif
1157 }
1158
1159 // After GC is complete, we must wait for all GC threads to enter the
1160 // standby state, otherwise they may still be executing inside
1161 // any_work(), and may even remain awake until the next GC starts.
1162 static void
1163 shutdown_gc_threads (nat n_threads USED_IF_THREADS, nat me USED_IF_THREADS)
1164 {
1165 #if defined(THREADED_RTS)
1166     nat i;
1167     for (i=0; i < n_threads; i++) {
1168         if (i == me) continue;
1169         while (gc_threads[i]->wakeup != GC_THREAD_WAITING_TO_CONTINUE) { write_barrier(); }
1170     }
1171 #endif
1172 }
1173
1174 #if defined(THREADED_RTS)
1175 void
1176 releaseGCThreads (Capability *cap USED_IF_THREADS)
1177 {
1178     nat n_threads = RtsFlags.ParFlags.nNodes;
1179     nat me = cap->no;
1180     nat i;
1181     for (i=0; i < n_threads; i++) {
1182         if (i == me) continue;
1183         if (gc_threads[i]->wakeup != GC_THREAD_WAITING_TO_CONTINUE)
1184             barf("releaseGCThreads");
1185
1186         gc_threads[i]->wakeup = GC_THREAD_INACTIVE;
1187         ACQUIRE_SPIN_LOCK(&gc_threads[i]->gc_spin);
1188         RELEASE_SPIN_LOCK(&gc_threads[i]->mut_spin);
1189     }
1190 }
1191 #endif
1192
1193 /* ----------------------------------------------------------------------------
1194    Initialise a generation that is to be collected
1195    ------------------------------------------------------------------------- */
1196
1197 static void
1198 init_collected_gen (nat g, nat n_threads)
1199 {
1200     nat t, i;
1201     gen_workspace *ws;
1202     generation *gen;
1203     bdescr *bd;
1204
1205     // Throw away the current mutable list.  Invariant: the mutable
1206     // list always has at least one block; this means we can avoid a
1207     // check for NULL in recordMutable().
1208     if (g != 0) {
1209         freeChain(generations[g].mut_list);
1210         generations[g].mut_list = allocBlock();
1211         for (i = 0; i < n_capabilities; i++) {
1212             freeChain(capabilities[i].mut_lists[g]);
1213             capabilities[i].mut_lists[g] = allocBlock();
1214         }
1215     }
1216
1217     gen = &generations[g];
1218     ASSERT(gen->no == g);
1219
1220     // we'll construct a new list of threads in this step
1221     // during GC, throw away the current list.
1222     gen->old_threads = gen->threads;
1223     gen->threads = END_TSO_QUEUE;
1224
1225     // deprecate the existing blocks
1226     gen->old_blocks   = gen->blocks;
1227     gen->n_old_blocks = gen->n_blocks;
1228     gen->blocks       = NULL;
1229     gen->n_blocks     = 0;
1230     gen->n_words      = 0;
1231     gen->live_estimate = 0;
1232
1233     // initialise the large object queues.
1234     gen->scavenged_large_objects = NULL;
1235     gen->n_scavenged_large_blocks = 0;
1236
1237     // mark the small objects as from-space
1238     for (bd = gen->old_blocks; bd; bd = bd->link) {
1239         bd->flags &= ~BF_EVACUATED;
1240     }
1241
1242     // mark the large objects as from-space
1243     for (bd = gen->large_objects; bd; bd = bd->link) {
1244         bd->flags &= ~BF_EVACUATED;
1245     }
1246
1247     // for a compacted generation, we need to allocate the bitmap
1248     if (gen->mark) {
1249         nat bitmap_size; // in bytes
1250         bdescr *bitmap_bdescr;
1251         StgWord *bitmap;
1252
1253         bitmap_size = gen->n_old_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
1254
1255         if (bitmap_size > 0) {
1256             bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size)
1257                                        / BLOCK_SIZE);
1258             gen->bitmap = bitmap_bdescr;
1259             bitmap = bitmap_bdescr->start;
1260
1261             debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
1262                        bitmap_size, bitmap);
1263
1264             // don't forget to fill it with zeros!
1265             memset(bitmap, 0, bitmap_size);
1266
1267             // For each block in this step, point to its bitmap from the
1268             // block descriptor.
1269             for (bd=gen->old_blocks; bd != NULL; bd = bd->link) {
1270                 bd->u.bitmap = bitmap;
1271                 bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
1272
1273                 // Also at this point we set the BF_MARKED flag
1274                 // for this block.  The invariant is that
1275                 // BF_MARKED is always unset, except during GC
1276                 // when it is set on those blocks which will be
1277                 // compacted.
1278                 if (!(bd->flags & BF_FRAGMENTED)) {
1279                     bd->flags |= BF_MARKED;
1280                 }
1281             }
1282         }
1283     }
1284
1285     // For each GC thread, for each step, allocate a "todo" block to
1286     // store evacuated objects to be scavenged, and a block to store
1287     // evacuated objects that do not need to be scavenged.
1288     for (t = 0; t < n_threads; t++) {
1289         ws = &gc_threads[t]->gens[g];
1290
1291         ws->todo_large_objects = NULL;
1292
1293         ws->part_list = NULL;
1294         ws->n_part_blocks = 0;
1295
1296         // allocate the first to-space block; extra blocks will be
1297         // chained on as necessary.
1298         ws->todo_bd = NULL;
1299         ASSERT(looksEmptyWSDeque(ws->todo_q));
1300         alloc_todo_block(ws,0);
1301
1302         ws->todo_overflow = NULL;
1303         ws->n_todo_overflow = 0;
1304
1305         ws->scavd_list = NULL;
1306         ws->n_scavd_blocks = 0;
1307     }
1308 }
1309
1310
1311 /* ----------------------------------------------------------------------------
1312    Initialise a generation that is *not* to be collected
1313    ------------------------------------------------------------------------- */
1314
1315 static void
1316 init_uncollected_gen (nat g, nat threads)
1317 {
1318     nat t, n;
1319     gen_workspace *ws;
1320     generation *gen;
1321     bdescr *bd;
1322
1323     // save the current mutable lists for this generation, and
1324     // allocate a fresh block for each one.  We'll traverse these
1325     // mutable lists as roots early on in the GC.
1326     generations[g].saved_mut_list = generations[g].mut_list;
1327     generations[g].mut_list = allocBlock();
1328     for (n = 0; n < n_capabilities; n++) {
1329         capabilities[n].saved_mut_lists[g] = capabilities[n].mut_lists[g];
1330         capabilities[n].mut_lists[g] = allocBlock();
1331     }
1332
1333     gen = &generations[g];
1334
1335     gen->scavenged_large_objects = NULL;
1336     gen->n_scavenged_large_blocks = 0;
1337
1338     for (t = 0; t < threads; t++) {
1339         ws = &gc_threads[t]->gens[g];
1340
1341         ASSERT(looksEmptyWSDeque(ws->todo_q));
1342         ws->todo_large_objects = NULL;
1343
1344         ws->part_list = NULL;
1345         ws->n_part_blocks = 0;
1346
1347         ws->scavd_list = NULL;
1348         ws->n_scavd_blocks = 0;
1349
1350         // If the block at the head of the list in this generation
1351         // is less than 3/4 full, then use it as a todo block.
1352         if (gen->blocks && isPartiallyFull(gen->blocks))
1353         {
1354             ws->todo_bd = gen->blocks;
1355             ws->todo_free = ws->todo_bd->free;
1356             ws->todo_lim = ws->todo_bd->start + BLOCK_SIZE_W;
1357             gen->blocks = gen->blocks->link;
1358             gen->n_blocks -= 1;
1359             gen->n_words -= ws->todo_bd->free - ws->todo_bd->start;
1360             ws->todo_bd->link = NULL;
1361             // we must scan from the current end point.
1362             ws->todo_bd->u.scan = ws->todo_bd->free;
1363         }
1364         else
1365         {
1366             ws->todo_bd = NULL;
1367             alloc_todo_block(ws,0);
1368         }
1369     }
1370
1371     // deal out any more partial blocks to the threads' part_lists
1372     t = 0;
1373     while (gen->blocks && isPartiallyFull(gen->blocks))
1374     {
1375         bd = gen->blocks;
1376         gen->blocks = bd->link;
1377         ws = &gc_threads[t]->gens[g];
1378         bd->link = ws->part_list;
1379         ws->part_list = bd;
1380         ws->n_part_blocks += 1;
1381         bd->u.scan = bd->free;
1382         gen->n_blocks -= 1;
1383         gen->n_words -= bd->free - bd->start;
1384         t++;
1385         if (t == n_gc_threads) t = 0;
1386     }
1387 }
1388
1389 /* -----------------------------------------------------------------------------
1390    Initialise a gc_thread before GC
1391    -------------------------------------------------------------------------- */
1392
1393 static void
1394 init_gc_thread (gc_thread *t)
1395 {
1396     t->static_objects = END_OF_STATIC_LIST;
1397     t->scavenged_static_objects = END_OF_STATIC_LIST;
1398     t->scan_bd = NULL;
1399     t->mut_lists = capabilities[t->thread_index].mut_lists;
1400     t->evac_gen = 0;
1401     t->failed_to_evac = rtsFalse;
1402     t->eager_promotion = rtsTrue;
1403     t->thunk_selector_depth = 0;
1404     t->copied = 0;
1405     t->scanned = 0;
1406     t->any_work = 0;
1407     t->no_work = 0;
1408     t->scav_find_work = 0;
1409 }
1410
1411 /* -----------------------------------------------------------------------------
1412    Function we pass to evacuate roots.
1413    -------------------------------------------------------------------------- */
1414
1415 static void
1416 mark_root(void *user USED_IF_THREADS, StgClosure **root)
1417 {
1418     // we stole a register for gct, but this function is called from
1419     // *outside* the GC where the register variable is not in effect,
1420     // so we need to save and restore it here.  NB. only call
1421     // mark_root() from the main GC thread, otherwise gct will be
1422     // incorrect.
1423     gc_thread *saved_gct;
1424     saved_gct = gct;
1425     SET_GCT(user);
1426
1427     evacuate(root);
1428
1429     SET_GCT(saved_gct);
1430 }
1431
1432 /* -----------------------------------------------------------------------------
1433    Initialising the static object & mutable lists
1434    -------------------------------------------------------------------------- */
1435
1436 static void
1437 zero_static_object_list(StgClosure* first_static)
1438 {
1439   StgClosure* p;
1440   StgClosure* link;
1441   const StgInfoTable *info;
1442
1443   for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
1444     info = get_itbl(p);
1445     link = *STATIC_LINK(info, p);
1446     *STATIC_LINK(info,p) = NULL;
1447   }
1448 }
1449
1450 /* ----------------------------------------------------------------------------
1451    Reset the sizes of the older generations when we do a major
1452    collection.
1453
1454    CURRENT STRATEGY: make all generations except zero the same size.
1455    We have to stay within the maximum heap size, and leave a certain
1456    percentage of the maximum heap size available to allocate into.
1457    ------------------------------------------------------------------------- */
1458
1459 static void
1460 resize_generations (void)
1461 {
1462     nat g;
1463
1464     if (major_gc && RtsFlags.GcFlags.generations > 1) {
1465         nat live, size, min_alloc, words;
1466         nat max  = RtsFlags.GcFlags.maxHeapSize;
1467         nat gens = RtsFlags.GcFlags.generations;
1468
1469         // live in the oldest generations
1470         if (oldest_gen->live_estimate != 0) {
1471             words = oldest_gen->live_estimate;
1472         } else {
1473             words = oldest_gen->n_words;
1474         }
1475         live = (words + BLOCK_SIZE_W - 1) / BLOCK_SIZE_W +
1476             oldest_gen->n_large_blocks;
1477
1478         // default max size for all generations except zero
1479         size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
1480                        RtsFlags.GcFlags.minOldGenSize);
1481
1482         if (RtsFlags.GcFlags.heapSizeSuggestionAuto) {
1483             RtsFlags.GcFlags.heapSizeSuggestion = size;
1484         }
1485
1486         // minimum size for generation zero
1487         min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200,
1488                             RtsFlags.GcFlags.minAllocAreaSize);
1489
1490         // Auto-enable compaction when the residency reaches a
1491         // certain percentage of the maximum heap size (default: 30%).
1492         if (RtsFlags.GcFlags.generations > 1 &&
1493             (RtsFlags.GcFlags.compact ||
1494              (max > 0 &&
1495               oldest_gen->n_blocks >
1496               (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
1497             oldest_gen->mark = 1;
1498             oldest_gen->compact = 1;
1499 //        debugBelch("compaction: on\n", live);
1500         } else {
1501             oldest_gen->mark = 0;
1502             oldest_gen->compact = 0;
1503 //        debugBelch("compaction: off\n", live);
1504         }
1505
1506         if (RtsFlags.GcFlags.sweep) {
1507             oldest_gen->mark = 1;
1508         }
1509
1510         // if we're going to go over the maximum heap size, reduce the
1511         // size of the generations accordingly.  The calculation is
1512         // different if compaction is turned on, because we don't need
1513         // to double the space required to collect the old generation.
1514         if (max != 0) {
1515
1516             // this test is necessary to ensure that the calculations
1517             // below don't have any negative results - we're working
1518             // with unsigned values here.
1519             if (max < min_alloc) {
1520                 heapOverflow();
1521             }
1522
1523             if (oldest_gen->compact) {
1524                 if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
1525                     size = (max - min_alloc) / ((gens - 1) * 2 - 1);
1526                 }
1527             } else {
1528                 if ( (size * (gens - 1) * 2) + min_alloc > max ) {
1529                     size = (max - min_alloc) / ((gens - 1) * 2);
1530                 }
1531             }
1532
1533             if (size < live) {
1534                 heapOverflow();
1535             }
1536         }
1537
1538 #if 0
1539         debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
1540                    min_alloc, size, max);
1541 #endif
1542
1543         for (g = 0; g < gens; g++) {
1544             generations[g].max_blocks = size;
1545         }
1546     }
1547 }
1548
1549 /* -----------------------------------------------------------------------------
1550    Calculate the new size of the nursery, and resize it.
1551    -------------------------------------------------------------------------- */
1552
1553 static void
1554 resize_nursery (void)
1555 {
1556     lnat min_nursery = RtsFlags.GcFlags.minAllocAreaSize * n_capabilities;
1557
1558     if (RtsFlags.GcFlags.generations == 1)
1559     {   // Two-space collector:
1560         nat blocks;
1561
1562         /* set up a new nursery.  Allocate a nursery size based on a
1563          * function of the amount of live data (by default a factor of 2)
1564          * Use the blocks from the old nursery if possible, freeing up any
1565          * left over blocks.
1566          *
1567          * If we get near the maximum heap size, then adjust our nursery
1568          * size accordingly.  If the nursery is the same size as the live
1569          * data (L), then we need 3L bytes.  We can reduce the size of the
1570          * nursery to bring the required memory down near 2L bytes.
1571          *
1572          * A normal 2-space collector would need 4L bytes to give the same
1573          * performance we get from 3L bytes, reducing to the same
1574          * performance at 2L bytes.
1575          */
1576         blocks = generations[0].n_blocks;
1577
1578         if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
1579              blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
1580              RtsFlags.GcFlags.maxHeapSize )
1581         {
1582             long adjusted_blocks;  // signed on purpose
1583             int pc_free;
1584
1585             adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
1586
1587             debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld",
1588                        RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
1589
1590             pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
1591             if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even * be < 0 */
1592             {
1593                 heapOverflow();
1594             }
1595             blocks = adjusted_blocks;
1596         }
1597         else
1598         {
1599             blocks *= RtsFlags.GcFlags.oldGenFactor;
1600             if (blocks < min_nursery)
1601             {
1602                 blocks = min_nursery;
1603             }
1604         }
1605         resizeNurseries(blocks);
1606     }
1607     else  // Generational collector
1608     {
1609         /*
1610          * If the user has given us a suggested heap size, adjust our
1611          * allocation area to make best use of the memory available.
1612          */
1613         if (RtsFlags.GcFlags.heapSizeSuggestion)
1614         {
1615             long blocks;
1616             nat needed = calcNeeded();  // approx blocks needed at next GC
1617
1618             /* Guess how much will be live in generation 0 step 0 next time.
1619              * A good approximation is obtained by finding the
1620              * percentage of g0 that was live at the last minor GC.
1621              *
1622              * We have an accurate figure for the amount of copied data in
1623              * 'copied', but we must convert this to a number of blocks, with
1624              * a small adjustment for estimated slop at the end of a block
1625              * (- 10 words).
1626              */
1627             if (N == 0)
1628             {
1629                 g0_pcnt_kept = ((copied / (BLOCK_SIZE_W - 10)) * 100)
1630                     / countNurseryBlocks();
1631             }
1632
1633             /* Estimate a size for the allocation area based on the
1634              * information available.  We might end up going slightly under
1635              * or over the suggested heap size, but we should be pretty
1636              * close on average.
1637              *
1638              * Formula:            suggested - needed
1639              *                ----------------------------
1640              *                    1 + g0_pcnt_kept/100
1641              *
1642              * where 'needed' is the amount of memory needed at the next
1643              * collection for collecting all gens except g0.
1644              */
1645             blocks =
1646                 (((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
1647                 (100 + (long)g0_pcnt_kept);
1648
1649             if (blocks < (long)min_nursery) {
1650                 blocks = min_nursery;
1651             }
1652
1653             resizeNurseries((nat)blocks);
1654         }
1655         else
1656         {
1657             // we might have added extra large blocks to the nursery, so
1658             // resize back to minAllocAreaSize again.
1659             resizeNurseriesFixed(RtsFlags.GcFlags.minAllocAreaSize);
1660         }
1661     }
1662 }
1663
1664 /* -----------------------------------------------------------------------------
1665    Sanity code for CAF garbage collection.
1666
1667    With DEBUG turned on, we manage a CAF list in addition to the SRT
1668    mechanism.  After GC, we run down the CAF list and blackhole any
1669    CAFs which have been garbage collected.  This means we get an error
1670    whenever the program tries to enter a garbage collected CAF.
1671
1672    Any garbage collected CAFs are taken off the CAF list at the same
1673    time.
1674    -------------------------------------------------------------------------- */
1675
1676 #if 0 && defined(DEBUG)
1677
1678 static void
1679 gcCAFs(void)
1680 {
1681   StgClosure*  p;
1682   StgClosure** pp;
1683   const StgInfoTable *info;
1684   nat i;
1685
1686   i = 0;
1687   p = caf_list;
1688   pp = &caf_list;
1689
1690   while (p != NULL) {
1691
1692     info = get_itbl(p);
1693
1694     ASSERT(info->type == IND_STATIC);
1695
1696     if (STATIC_LINK(info,p) == NULL) {
1697         debugTrace(DEBUG_gccafs, "CAF gc'd at 0x%04lx", (long)p);
1698         // black hole it
1699         SET_INFO(p,&stg_BLACKHOLE_info);
1700         p = STATIC_LINK2(info,p);
1701         *pp = p;
1702     }
1703     else {
1704       pp = &STATIC_LINK2(info,p);
1705       p = *pp;
1706       i++;
1707     }
1708
1709   }
1710
1711   debugTrace(DEBUG_gccafs, "%d CAFs live", i);
1712 }
1713 #endif