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