rts/sm/GC.c

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