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