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