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