rts/sm/GC.c

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