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