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 (ToDo: check all threads)
 272   IF_DEBUG(sanity, checkFreeListSanity());
 273
 274   // Initialise all our gc_thread structures
 275   for (t = 0; t < n_gc_threads; t++) {
 276       init_gc_thread(gc_threads[t]);
 277   }
 278
 279   // Initialise all the generations/steps that we're collecting.
 280   for (g = 0; g <= N; g++) {
 281       init_collected_gen(g,n_gc_threads);
 282   }
 283
 284   // Initialise all the generations/steps that we're *not* collecting.
 285   for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
 286       init_uncollected_gen(g,n_gc_threads);
 287   }
 288
 289   /* Allocate a mark stack if we're doing a major collection.
 290    */
 291   if (major_gc) {
 292       nat mark_stack_blocks;
 293       mark_stack_blocks = stg_max(MARK_STACK_BLOCKS,
 294                                   oldest_gen->steps[0].n_old_blocks / 100);
 295       mark_stack_bdescr = allocGroup(mark_stack_blocks);
 296       mark_stack = (StgPtr *)mark_stack_bdescr->start;
 297       mark_sp    = mark_stack;
 298       mark_splim = mark_stack + (mark_stack_blocks * BLOCK_SIZE_W);
 299   } else {
 300       mark_stack_bdescr = NULL;
 301   }
 302
 303   // this is the main thread
 304   gct = gc_threads[0];
 305
 306   /* -----------------------------------------------------------------------
 307    * follow all the roots that we know about:
 308    *   - mutable lists from each generation > N
 309    * we want to *scavenge* these roots, not evacuate them: they're not
 310    * going to move in this GC.
 311    * Also do them in reverse generation order, for the usual reason:
 312    * namely to reduce the likelihood of spurious old->new pointers.
 313    */
 314   for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
 315       generations[g].saved_mut_list = generations[g].mut_list;
 316       generations[g].mut_list = allocBlock();
 317       // mut_list always has at least one block.
 318   }
 319
 320   // the main thread is running: this prevents any other threads from
 321   // exiting prematurely, so we can start them now.
 322   // NB. do this after the mutable lists have been saved above, otherwise
 323   // the other GC threads will be writing into the old mutable lists.
 324   inc_running();
 325   wakeup_gc_threads(n_gc_threads);
 326
 327   for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
 328       scavenge_mutable_list(&generations[g]);
 329   }
 330
 331   // follow roots from the CAF list (used by GHCi)
 332   gct->evac_step = 0;
 333   markCAFs(mark_root, gct);
 334
 335   // follow all the roots that the application knows about.
 336   gct->evac_step = 0;
 337   markSomeCapabilities(mark_root, gct, gct->thread_index, n_gc_threads);
 338
 339 #if defined(RTS_USER_SIGNALS)
 340   // mark the signal handlers (signals should be already blocked)
 341   markSignalHandlers(mark_root, gct);
 342 #endif
 343
 344   // Mark the weak pointer list, and prepare to detect dead weak pointers.
 345   markWeakPtrList();
 346   initWeakForGC();
 347
 348   // Mark the stable pointer table.
 349   markStablePtrTable(mark_root, gct);
 350
 351   /* -------------------------------------------------------------------------
 352    * Repeatedly scavenge all the areas we know about until there's no
 353    * more scavenging to be done.
 354    */
 355   for (;;)
 356   {
 357       scavenge_until_all_done();
 358       // The other threads are now stopped.  We might recurse back to
 359       // here, but from now on this is the only thread.
 360
 361       // if any blackholes are alive, make the threads that wait on
 362       // them alive too.
 363       if (traverseBlackholeQueue()) {
 364           inc_running();
 365           continue;
 366       }
 367
 368       // must be last...  invariant is that everything is fully
 369       // scavenged at this point.
 370       if (traverseWeakPtrList()) { // returns rtsTrue if evaced something
 371           inc_running();
 372           continue;
 373       }
 374
 375       // If we get to here, there's really nothing left to do.
 376       break;
 377   }
 378
 379   shutdown_gc_threads(n_gc_threads);
 380
 381   // Update pointers from the Task list
 382   update_task_list();
 383
 384   // Now see which stable names are still alive.
 385   gcStablePtrTable();
 386
 387 #ifdef PROFILING
 388   // We call processHeapClosureForDead() on every closure destroyed during
 389   // the current garbage collection, so we invoke LdvCensusForDead().
 390   if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
 391       || RtsFlags.ProfFlags.bioSelector != NULL)
 392     LdvCensusForDead(N);
 393 #endif
 394
 395   // NO MORE EVACUATION AFTER THIS POINT!
 396
 397   // Two-space collector: free the old to-space.
 398   // g0s0->old_blocks is the old nursery
 399   // g0s0->blocks is to-space from the previous GC
 400   if (RtsFlags.GcFlags.generations == 1) {
 401       if (g0s0->blocks != NULL) {
 402           freeChain(g0s0->blocks);
 403           g0s0->blocks = NULL;
 404       }
 405   }
 406
 407   // For each workspace, in each thread, move the copied blocks to the step
 408   {
 409       gc_thread *thr;
 410       step_workspace *ws;
 411       bdescr *prev, *next;
 412
 413       for (t = 0; t < n_gc_threads; t++) {
 414           thr = gc_threads[t];
 415
 416           // not step 0
 417           if (RtsFlags.GcFlags.generations == 1) {
 418               s = 0;
 419           } else {
 420               s = 1;
 421           }
 422           for (; s < total_steps; s++) {
 423               ws = &thr->steps[s];
 424
 425               // Push the final block
 426               if (ws->todo_bd) {
 427                   push_scanned_block(ws->todo_bd, ws);
 428               }
 429
 430               ASSERT(gct->scan_bd == NULL);
 431               ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks);
 432
 433               prev = NULL;
 434               for (bd = ws->scavd_list; bd != NULL; bd = bd->link) {
 435                   ws->step->n_words += bd->free - bd->start;
 436                   prev = bd;
 437               }
 438               if (prev != NULL) {
 439                   prev->link = ws->step->blocks;
 440                   ws->step->blocks = ws->scavd_list;
 441               }
 442               ws->step->n_blocks += ws->n_scavd_blocks;
 443           }
 444       }
 445
 446       // Add all the partial blocks *after* we've added all the full
 447       // blocks.  This is so that we can grab the partial blocks back
 448       // again and try to fill them up in the next GC.
 449       for (t = 0; t < n_gc_threads; t++) {
 450           thr = gc_threads[t];
 451
 452           // not step 0
 453           if (RtsFlags.GcFlags.generations == 1) {
 454               s = 0;
 455           } else {
 456               s = 1;
 457           }
 458           for (; s < total_steps; s++) {
 459               ws = &thr->steps[s];
 460
 461               prev = NULL;
 462               for (bd = ws->part_list; bd != NULL; bd = next) {
 463                   next = bd->link;
 464                   if (bd->free == bd->start) {
 465                       if (prev == NULL) {
 466                           ws->part_list = next;
 467                       } else {
 468                           prev->link = next;
 469                       }
 470                       freeGroup(bd);
 471                       ws->n_part_blocks--;
 472                   } else {
 473                       ws->step->n_words += bd->free - bd->start;
 474                       prev = bd;
 475                   }
 476               }
 477               if (prev != NULL) {
 478                   prev->link = ws->step->blocks;
 479                   ws->step->blocks = ws->part_list;
 480               }
 481               ws->step->n_blocks += ws->n_part_blocks;
 482
 483               ASSERT(countBlocks(ws->step->blocks) == ws->step->n_blocks);
 484               ASSERT(countOccupied(ws->step->blocks) == ws->step->n_words);
 485           }
 486       }
 487   }
 488
 489   // Finally: compact or sweep the oldest generation.
 490   if (major_gc && oldest_gen->steps[0].mark) {
 491       if (oldest_gen->steps[0].compact)
 492           compact(gct->scavenged_static_objects);
 493       else
 494           sweep(&oldest_gen->steps[0]);
 495   }
 496
 497   IF_DEBUG(sanity, checkGlobalTSOList(rtsFalse));
 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
1010     scavenge_until_all_done();
1011 }
1012
1013
1014 static void
1015 gc_thread_mainloop (void)
1016 {
1017     while (!gct->exit) {
1018
1019         // Wait until we're told to wake up
1020         ACQUIRE_LOCK(&gct->wake_mutex);
1021         gct->wakeup = rtsFalse;
1022         while (!gct->wakeup) {
1023             debugTrace(DEBUG_gc, "GC thread %d standing by...",
1024                        gct->thread_index);
1025             waitCondition(&gct->wake_cond, &gct->wake_mutex);
1026         }
1027         RELEASE_LOCK(&gct->wake_mutex);
1028         if (gct->exit) break;
1029
1030 #ifdef USE_PAPI
1031         // start performance counters in this thread...
1032         if (gct->papi_events == -1) {
1033             papi_init_eventset(&gct->papi_events);
1034         }
1035         papi_thread_start_gc1_count(gct->papi_events);
1036 #endif
1037
1038         gc_thread_work();
1039
1040 #ifdef USE_PAPI
1041         // count events in this thread towards the GC totals
1042         papi_thread_stop_gc1_count(gct->papi_events);
1043 #endif
1044     }
1045 }
1046 #endif
1047
1048 #if defined(THREADED_RTS)
1049 static void
1050 gc_thread_entry (gc_thread *my_gct)
1051 {
1052     gct = my_gct;
1053     debugTrace(DEBUG_gc, "GC thread %d starting...", gct->thread_index);
1054     gct->id = osThreadId();
1055     gc_thread_mainloop();
1056 }
1057 #endif
1058
1059 static void
1060 start_gc_threads (void)
1061 {
1062 #if defined(THREADED_RTS)
1063     nat i;
1064     OSThreadId id;
1065     static rtsBool done = rtsFalse;
1066
1067     gc_running_threads = 0;
1068     initMutex(&gc_running_mutex);
1069
1070     if (!done) {
1071         // Start from 1: the main thread is 0
1072         for (i = 1; i < RtsFlags.ParFlags.gcThreads; i++) {
1073             createOSThread(&id, (OSThreadProc*)&gc_thread_entry,
1074                            gc_threads[i]);
1075         }
1076         done = rtsTrue;
1077     }
1078 #endif
1079 }
1080
1081 static void
1082 wakeup_gc_threads (nat n_threads USED_IF_THREADS)
1083 {
1084 #if defined(THREADED_RTS)
1085     nat i;
1086     for (i=1; i < n_threads; i++) {
1087         inc_running();
1088         debugTrace(DEBUG_gc, "waking up gc thread %d", i);
1089         do {
1090             ACQUIRE_LOCK(&gc_threads[i]->wake_mutex);
1091             if (gc_threads[i]->wakeup) {
1092                 RELEASE_LOCK(&gc_threads[i]->wake_mutex);
1093                 continue;
1094             } else {
1095                 break;
1096             }
1097         } while (1);
1098         gc_threads[i]->wakeup = rtsTrue;
1099         signalCondition(&gc_threads[i]->wake_cond);
1100         RELEASE_LOCK(&gc_threads[i]->wake_mutex);
1101     }
1102 #endif
1103 }
1104
1105 // After GC is complete, we must wait for all GC threads to enter the
1106 // standby state, otherwise they may still be executing inside
1107 // any_work(), and may even remain awake until the next GC starts.
1108 static void
1109 shutdown_gc_threads (nat n_threads USED_IF_THREADS)
1110 {
1111 #if defined(THREADED_RTS)
1112     nat i;
1113     rtsBool wakeup;
1114     for (i=1; i < n_threads; i++) {
1115         do {
1116             ACQUIRE_LOCK(&gc_threads[i]->wake_mutex);
1117             wakeup = gc_threads[i]->wakeup;
1118             // wakeup is false while the thread is waiting
1119             RELEASE_LOCK(&gc_threads[i]->wake_mutex);
1120         } while (wakeup);
1121     }
1122 #endif
1123 }
1124
1125 /* ----------------------------------------------------------------------------
1126    Initialise a generation that is to be collected
1127    ------------------------------------------------------------------------- */
1128
1129 static void
1130 init_collected_gen (nat g, nat n_threads)
1131 {
1132     nat s, t, i;
1133     step_workspace *ws;
1134     step *stp;
1135     bdescr *bd;
1136
1137     // Throw away the current mutable list.  Invariant: the mutable
1138     // list always has at least one block; this means we can avoid a
1139     // check for NULL in recordMutable().
1140     if (g != 0) {
1141         freeChain(generations[g].mut_list);
1142         generations[g].mut_list = allocBlock();
1143         for (i = 0; i < n_capabilities; i++) {
1144             freeChain(capabilities[i].mut_lists[g]);
1145             capabilities[i].mut_lists[g] = allocBlock();
1146         }
1147     }
1148
1149     for (s = 0; s < generations[g].n_steps; s++) {
1150
1151         stp = &generations[g].steps[s];
1152         ASSERT(stp->gen_no == g);
1153
1154         // we'll construct a new list of threads in this step
1155         // during GC, throw away the current list.
1156         stp->old_threads = stp->threads;
1157         stp->threads = END_TSO_QUEUE;
1158
1159         // generation 0, step 0 doesn't need to-space
1160         if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) {
1161             continue;
1162         }
1163
1164         // deprecate the existing blocks
1165         stp->old_blocks   = stp->blocks;
1166         stp->n_old_blocks = stp->n_blocks;
1167         stp->blocks       = NULL;
1168         stp->n_blocks     = 0;
1169         stp->n_words      = 0;
1170         stp->live_estimate = 0;
1171
1172         // we don't have any to-be-scavenged blocks yet
1173         stp->todos = NULL;
1174         stp->todos_last = NULL;
1175         stp->n_todos = 0;
1176
1177         // initialise the large object queues.
1178         stp->scavenged_large_objects = NULL;
1179         stp->n_scavenged_large_blocks = 0;
1180
1181         // mark the small objects as from-space
1182         for (bd = stp->old_blocks; bd; bd = bd->link) {
1183             bd->flags &= ~BF_EVACUATED;
1184         }
1185
1186         // mark the large objects as from-space
1187         for (bd = stp->large_objects; bd; bd = bd->link) {
1188             bd->flags &= ~BF_EVACUATED;
1189         }
1190
1191         // for a compacted step, we need to allocate the bitmap
1192         if (stp->mark) {
1193             nat bitmap_size; // in bytes
1194             bdescr *bitmap_bdescr;
1195             StgWord *bitmap;
1196
1197             bitmap_size = stp->n_old_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
1198
1199             if (bitmap_size > 0) {
1200                 bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size)
1201                                            / BLOCK_SIZE);
1202                 stp->bitmap = bitmap_bdescr;
1203                 bitmap = bitmap_bdescr->start;
1204
1205                 debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
1206                            bitmap_size, bitmap);
1207
1208                 // don't forget to fill it with zeros!
1209                 memset(bitmap, 0, bitmap_size);
1210
1211                 // For each block in this step, point to its bitmap from the
1212                 // block descriptor.
1213                 for (bd=stp->old_blocks; bd != NULL; bd = bd->link) {
1214                     bd->u.bitmap = bitmap;
1215                     bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
1216
1217                     // Also at this point we set the BF_MARKED flag
1218                     // for this block.  The invariant is that
1219                     // BF_MARKED is always unset, except during GC
1220                     // when it is set on those blocks which will be
1221                     // compacted.
1222                     if (!(bd->flags & BF_FRAGMENTED)) {
1223                         bd->flags |= BF_MARKED;
1224                     }
1225                 }
1226             }
1227         }
1228     }
1229
1230     // For each GC thread, for each step, allocate a "todo" block to
1231     // store evacuated objects to be scavenged, and a block to store
1232     // evacuated objects that do not need to be scavenged.
1233     for (t = 0; t < n_threads; t++) {
1234         for (s = 0; s < generations[g].n_steps; s++) {
1235
1236             // we don't copy objects into g0s0, unless -G0
1237             if (g==0 && s==0 && RtsFlags.GcFlags.generations > 1) continue;
1238
1239             ws = &gc_threads[t]->steps[g * RtsFlags.GcFlags.steps + s];
1240
1241             ws->todo_large_objects = NULL;
1242
1243             ws->part_list = NULL;
1244             ws->n_part_blocks = 0;
1245
1246             // allocate the first to-space block; extra blocks will be
1247             // chained on as necessary.
1248             ws->todo_bd = NULL;
1249             ws->buffer_todo_bd = NULL;
1250             alloc_todo_block(ws,0);
1251
1252             ws->scavd_list = NULL;
1253             ws->n_scavd_blocks = 0;
1254         }
1255     }
1256 }
1257
1258
1259 /* ----------------------------------------------------------------------------
1260    Initialise a generation that is *not* to be collected
1261    ------------------------------------------------------------------------- */
1262
1263 static void
1264 init_uncollected_gen (nat g, nat threads)
1265 {
1266     nat s, t, i;
1267     step_workspace *ws;
1268     step *stp;
1269     bdescr *bd;
1270
1271     for (s = 0; s < generations[g].n_steps; s++) {
1272         stp = &generations[g].steps[s];
1273         stp->scavenged_large_objects = NULL;
1274         stp->n_scavenged_large_blocks = 0;
1275     }
1276
1277     for (s = 0; s < generations[g].n_steps; s++) {
1278
1279         stp = &generations[g].steps[s];
1280
1281         for (t = 0; t < threads; t++) {
1282             ws = &gc_threads[t]->steps[g * RtsFlags.GcFlags.steps + s];
1283
1284             ws->buffer_todo_bd = NULL;
1285             ws->todo_large_objects = NULL;
1286
1287             ws->part_list = NULL;
1288             ws->n_part_blocks = 0;
1289
1290             ws->scavd_list = NULL;
1291             ws->n_scavd_blocks = 0;
1292
1293             // If the block at the head of the list in this generation
1294             // is less than 3/4 full, then use it as a todo block.
1295             if (stp->blocks && isPartiallyFull(stp->blocks))
1296             {
1297                 ws->todo_bd = stp->blocks;
1298                 ws->todo_free = ws->todo_bd->free;
1299                 ws->todo_lim = ws->todo_bd->start + BLOCK_SIZE_W;
1300                 stp->blocks = stp->blocks->link;
1301                 stp->n_blocks -= 1;
1302                 stp->n_words -= ws->todo_bd->free - ws->todo_bd->start;
1303                 ws->todo_bd->link = NULL;
1304                 // we must scan from the current end point.
1305                 ws->todo_bd->u.scan = ws->todo_bd->free;
1306             }
1307             else
1308             {
1309                 ws->todo_bd = NULL;
1310                 alloc_todo_block(ws,0);
1311             }
1312         }
1313
1314         // deal out any more partial blocks to the threads' part_lists
1315         t = 0;
1316         while (stp->blocks && isPartiallyFull(stp->blocks))
1317         {
1318             bd = stp->blocks;
1319             stp->blocks = bd->link;
1320             ws = &gc_threads[t]->steps[g * RtsFlags.GcFlags.steps + s];
1321             bd->link = ws->part_list;
1322             ws->part_list = bd;
1323             ws->n_part_blocks += 1;
1324             bd->u.scan = bd->free;
1325             stp->n_blocks -= 1;
1326             stp->n_words -= bd->free - bd->start;
1327             t++;
1328             if (t == n_gc_threads) t = 0;
1329         }
1330     }
1331
1332
1333     // Move the private mutable lists from each capability onto the
1334     // main mutable list for the generation.
1335     for (i = 0; i < n_capabilities; i++) {
1336         for (bd = capabilities[i].mut_lists[g];
1337              bd->link != NULL; bd = bd->link) {
1338             /* nothing */
1339         }
1340         bd->link = generations[g].mut_list;
1341         generations[g].mut_list = capabilities[i].mut_lists[g];
1342         capabilities[i].mut_lists[g] = allocBlock();
1343     }
1344 }
1345
1346 /* -----------------------------------------------------------------------------
1347    Initialise a gc_thread before GC
1348    -------------------------------------------------------------------------- */
1349
1350 static void
1351 init_gc_thread (gc_thread *t)
1352 {
1353     t->static_objects = END_OF_STATIC_LIST;
1354     t->scavenged_static_objects = END_OF_STATIC_LIST;
1355     t->scan_bd = NULL;
1356     t->evac_step = 0;
1357     t->failed_to_evac = rtsFalse;
1358     t->eager_promotion = rtsTrue;
1359     t->thunk_selector_depth = 0;
1360     t->copied = 0;
1361     t->scanned = 0;
1362     t->any_work = 0;
1363     t->no_work = 0;
1364     t->scav_find_work = 0;
1365 }
1366
1367 /* -----------------------------------------------------------------------------
1368    Function we pass to evacuate roots.
1369    -------------------------------------------------------------------------- */
1370
1371 static void
1372 mark_root(void *user, StgClosure **root)
1373 {
1374     // we stole a register for gct, but this function is called from
1375     // *outside* the GC where the register variable is not in effect,
1376     // so we need to save and restore it here.  NB. only call
1377     // mark_root() from the main GC thread, otherwise gct will be
1378     // incorrect.
1379     gc_thread *saved_gct;
1380     saved_gct = gct;
1381     gct = user;
1382
1383     evacuate(root);
1384
1385     gct = saved_gct;
1386 }
1387
1388 /* -----------------------------------------------------------------------------
1389    Initialising the static object & mutable lists
1390    -------------------------------------------------------------------------- */
1391
1392 static void
1393 zero_static_object_list(StgClosure* first_static)
1394 {
1395   StgClosure* p;
1396   StgClosure* link;
1397   const StgInfoTable *info;
1398
1399   for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
1400     info = get_itbl(p);
1401     link = *STATIC_LINK(info, p);
1402     *STATIC_LINK(info,p) = NULL;
1403   }
1404 }
1405
1406 /* ----------------------------------------------------------------------------
1407    Update the pointers from the task list
1408
1409    These are treated as weak pointers because we want to allow a main
1410    thread to get a BlockedOnDeadMVar exception in the same way as any
1411    other thread.  Note that the threads should all have been retained
1412    by GC by virtue of being on the all_threads list, we're just
1413    updating pointers here.
1414    ------------------------------------------------------------------------- */
1415
1416 static void
1417 update_task_list (void)
1418 {
1419     Task *task;
1420     StgTSO *tso;
1421     for (task = all_tasks; task != NULL; task = task->all_link) {
1422         if (!task->stopped && task->tso) {
1423             ASSERT(task->tso->bound == task);
1424             tso = (StgTSO *) isAlive((StgClosure *)task->tso);
1425             if (tso == NULL) {
1426                 barf("task %p: main thread %d has been GC'd",
1427 #ifdef THREADED_RTS
1428                      (void *)task->id,
1429 #else
1430                      (void *)task,
1431 #endif
1432                      task->tso->id);
1433             }
1434             task->tso = tso;
1435         }
1436     }
1437 }
1438
1439 /* ----------------------------------------------------------------------------
1440    Reset the sizes of the older generations when we do a major
1441    collection.
1442
1443    CURRENT STRATEGY: make all generations except zero the same size.
1444    We have to stay within the maximum heap size, and leave a certain
1445    percentage of the maximum heap size available to allocate into.
1446    ------------------------------------------------------------------------- */
1447
1448 static void
1449 resize_generations (void)
1450 {
1451     nat g;
1452
1453     if (major_gc && RtsFlags.GcFlags.generations > 1) {
1454         nat live, size, min_alloc, words;
1455         nat max  = RtsFlags.GcFlags.maxHeapSize;
1456         nat gens = RtsFlags.GcFlags.generations;
1457
1458         // live in the oldest generations
1459         if (oldest_gen->steps[0].live_estimate != 0) {
1460             words = oldest_gen->steps[0].live_estimate;
1461         } else {
1462             words = oldest_gen->steps[0].n_words;
1463         }
1464         live = (words + BLOCK_SIZE_W - 1) / BLOCK_SIZE_W +
1465             oldest_gen->steps[0].n_large_blocks;
1466
1467         // default max size for all generations except zero
1468         size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
1469                        RtsFlags.GcFlags.minOldGenSize);
1470
1471         // minimum size for generation zero
1472         min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200,
1473                             RtsFlags.GcFlags.minAllocAreaSize);
1474
1475         // Auto-enable compaction when the residency reaches a
1476         // certain percentage of the maximum heap size (default: 30%).
1477         if (RtsFlags.GcFlags.generations > 1 &&
1478             (RtsFlags.GcFlags.compact ||
1479              (max > 0 &&
1480               oldest_gen->steps[0].n_blocks >
1481               (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
1482             oldest_gen->steps[0].mark = 1;
1483             oldest_gen->steps[0].compact = 1;
1484 //        debugBelch("compaction: on\n", live);
1485         } else {
1486             oldest_gen->steps[0].mark = 0;
1487             oldest_gen->steps[0].compact = 0;
1488 //        debugBelch("compaction: off\n", live);
1489         }
1490
1491         if (RtsFlags.GcFlags.sweep) {
1492             oldest_gen->steps[0].mark = 1;
1493         }
1494
1495         // if we're going to go over the maximum heap size, reduce the
1496         // size of the generations accordingly.  The calculation is
1497         // different if compaction is turned on, because we don't need
1498         // to double the space required to collect the old generation.
1499         if (max != 0) {
1500
1501             // this test is necessary to ensure that the calculations
1502             // below don't have any negative results - we're working
1503             // with unsigned values here.
1504             if (max < min_alloc) {
1505                 heapOverflow();
1506             }
1507
1508             if (oldest_gen->steps[0].compact) {
1509                 if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
1510                     size = (max - min_alloc) / ((gens - 1) * 2 - 1);
1511                 }
1512             } else {
1513                 if ( (size * (gens - 1) * 2) + min_alloc > max ) {
1514                     size = (max - min_alloc) / ((gens - 1) * 2);
1515                 }
1516             }
1517
1518             if (size < live) {
1519                 heapOverflow();
1520             }
1521         }
1522
1523 #if 0
1524         debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
1525                    min_alloc, size, max);
1526 #endif
1527
1528         for (g = 0; g < gens; g++) {
1529             generations[g].max_blocks = size;
1530         }
1531     }
1532 }
1533
1534 /* -----------------------------------------------------------------------------
1535    Calculate the new size of the nursery, and resize it.
1536    -------------------------------------------------------------------------- */
1537
1538 static void
1539 resize_nursery (void)
1540 {
1541     if (RtsFlags.GcFlags.generations == 1)
1542     {   // Two-space collector:
1543         nat blocks;
1544
1545         /* set up a new nursery.  Allocate a nursery size based on a
1546          * function of the amount of live data (by default a factor of 2)
1547          * Use the blocks from the old nursery if possible, freeing up any
1548          * left over blocks.
1549          *
1550          * If we get near the maximum heap size, then adjust our nursery
1551          * size accordingly.  If the nursery is the same size as the live
1552          * data (L), then we need 3L bytes.  We can reduce the size of the
1553          * nursery to bring the required memory down near 2L bytes.
1554          *
1555          * A normal 2-space collector would need 4L bytes to give the same
1556          * performance we get from 3L bytes, reducing to the same
1557          * performance at 2L bytes.
1558          */
1559         blocks = g0s0->n_blocks;
1560
1561         if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
1562              blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
1563              RtsFlags.GcFlags.maxHeapSize )
1564         {
1565             long adjusted_blocks;  // signed on purpose
1566             int pc_free;
1567
1568             adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
1569
1570             debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld",
1571                        RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
1572
1573             pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
1574             if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even * be < 0 */
1575             {
1576                 heapOverflow();
1577             }
1578             blocks = adjusted_blocks;
1579         }
1580         else
1581         {
1582             blocks *= RtsFlags.GcFlags.oldGenFactor;
1583             if (blocks < RtsFlags.GcFlags.minAllocAreaSize)
1584             {
1585                 blocks = RtsFlags.GcFlags.minAllocAreaSize;
1586             }
1587         }
1588         resizeNurseries(blocks);
1589     }
1590     else  // Generational collector
1591     {
1592         /*
1593          * If the user has given us a suggested heap size, adjust our
1594          * allocation area to make best use of the memory available.
1595          */
1596         if (RtsFlags.GcFlags.heapSizeSuggestion)
1597         {
1598             long blocks;
1599             nat needed = calcNeeded();  // approx blocks needed at next GC
1600
1601             /* Guess how much will be live in generation 0 step 0 next time.
1602              * A good approximation is obtained by finding the
1603              * percentage of g0s0 that was live at the last minor GC.
1604              *
1605              * We have an accurate figure for the amount of copied data in
1606              * 'copied', but we must convert this to a number of blocks, with
1607              * a small adjustment for estimated slop at the end of a block
1608              * (- 10 words).
1609              */
1610             if (N == 0)
1611             {
1612                 g0s0_pcnt_kept = ((copied / (BLOCK_SIZE_W - 10)) * 100)
1613                     / countNurseryBlocks();
1614             }
1615
1616             /* Estimate a size for the allocation area based on the
1617              * information available.  We might end up going slightly under
1618              * or over the suggested heap size, but we should be pretty
1619              * close on average.
1620              *
1621              * Formula:            suggested - needed
1622              *                ----------------------------
1623              *                    1 + g0s0_pcnt_kept/100
1624              *
1625              * where 'needed' is the amount of memory needed at the next
1626              * collection for collecting all steps except g0s0.
1627              */
1628             blocks =
1629                 (((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
1630                 (100 + (long)g0s0_pcnt_kept);
1631
1632             if (blocks < (long)RtsFlags.GcFlags.minAllocAreaSize) {
1633                 blocks = RtsFlags.GcFlags.minAllocAreaSize;
1634             }
1635
1636             resizeNurseries((nat)blocks);
1637         }
1638         else
1639         {
1640             // we might have added extra large blocks to the nursery, so
1641             // resize back to minAllocAreaSize again.
1642             resizeNurseriesFixed(RtsFlags.GcFlags.minAllocAreaSize);
1643         }
1644     }
1645 }
1646
1647 /* -----------------------------------------------------------------------------
1648    Sanity code for CAF garbage collection.
1649
1650    With DEBUG turned on, we manage a CAF list in addition to the SRT
1651    mechanism.  After GC, we run down the CAF list and blackhole any
1652    CAFs which have been garbage collected.  This means we get an error
1653    whenever the program tries to enter a garbage collected CAF.
1654
1655    Any garbage collected CAFs are taken off the CAF list at the same
1656    time.
1657    -------------------------------------------------------------------------- */
1658
1659 #if 0 && defined(DEBUG)
1660
1661 static void
1662 gcCAFs(void)
1663 {
1664   StgClosure*  p;
1665   StgClosure** pp;
1666   const StgInfoTable *info;
1667   nat i;
1668
1669   i = 0;
1670   p = caf_list;
1671   pp = &caf_list;
1672
1673   while (p != NULL) {
1674
1675     info = get_itbl(p);
1676
1677     ASSERT(info->type == IND_STATIC);
1678
1679     if (STATIC_LINK(info,p) == NULL) {
1680         debugTrace(DEBUG_gccafs, "CAF gc'd at 0x%04lx", (long)p);
1681         // black hole it
1682         SET_INFO(p,&stg_BLACKHOLE_info);
1683         p = STATIC_LINK2(info,p);
1684         *pp = p;
1685     }
1686     else {
1687       pp = &STATIC_LINK2(info,p);
1688       p = *pp;
1689       i++;
1690     }
1691
1692   }
1693
1694   debugTrace(DEBUG_gccafs, "%d CAFs live", i);
1695 }
1696 #endif