rts/sm/GC.c

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