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