ghc/rts/Storage.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Storage.c,v 1.33 2001/01/24 15:46:19 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Storage manager front end
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "RtsUtils.h"
  12 #include "RtsFlags.h"
  13 #include "Stats.h"
  14 #include "Hooks.h"
  15 #include "BlockAlloc.h"
  16 #include "MBlock.h"
  17 #include "Weak.h"
  18 #include "Sanity.h"
  19
  20 #include "Storage.h"
  21 #include "Schedule.h"
  22 #include "StoragePriv.h"
  23
  24 #ifndef SMP
  25 nat nursery_blocks;             /* number of blocks in the nursery */
  26 #endif
  27
  28 StgClosure    *caf_list         = NULL;
  29
  30 bdescr *small_alloc_list;       /* allocate()d small objects */
  31 bdescr *large_alloc_list;       /* allocate()d large objects */
  32 nat alloc_blocks;               /* number of allocate()d blocks since GC */
  33 nat alloc_blocks_lim;           /* approximate limit on alloc_blocks */
  34
  35 StgPtr alloc_Hp    = NULL;      /* next free byte in small_alloc_list */
  36 StgPtr alloc_HpLim = NULL;      /* end of block at small_alloc_list   */
  37
  38 generation *generations;        /* all the generations */
  39 generation *g0;                 /* generation 0, for convenience */
  40 generation *oldest_gen;         /* oldest generation, for convenience */
  41 step *g0s0;                     /* generation 0, step 0, for convenience */
  42
  43 lnat total_allocated = 0;       /* total memory allocated during run */
  44
  45 /*
  46  * Storage manager mutex:  protects all the above state from
  47  * simultaneous access by two STG threads.
  48  */
  49 #ifdef SMP
  50 pthread_mutex_t sm_mutex = PTHREAD_MUTEX_INITIALIZER;
  51 #endif
  52
  53 /*
  54  * Forward references
  55  */
  56 static void *stgAllocForGMP   (size_t size_in_bytes);
  57 static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
  58 static void  stgDeallocForGMP (void *ptr, size_t size);
  59
  60 void
  61 initStorage (void)
  62 {
  63   nat g, s;
  64   step *stp;
  65   generation *gen;
  66
  67   /* If we're doing heap profiling, we want a two-space heap with a
  68    * fixed-size allocation area so that we get roughly even-spaced
  69    * samples.
  70    */
  71 #if defined(PROFILING) || defined(DEBUG)
  72   if (RtsFlags.ProfFlags.doHeapProfile) {
  73     RtsFlags.GcFlags.generations = 1;
  74     RtsFlags.GcFlags.steps = 1;
  75     RtsFlags.GcFlags.oldGenFactor = 0;
  76     RtsFlags.GcFlags.heapSizeSuggestion = 0;
  77   }
  78 #endif
  79
  80   if (RtsFlags.GcFlags.heapSizeSuggestion >
  81       RtsFlags.GcFlags.maxHeapSize) {
  82     RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
  83   }
  84
  85   initBlockAllocator();
  86
  87   /* allocate generation info array */
  88   generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations
  89                                              * sizeof(struct _generation),
  90                                              "initStorage: gens");
  91
  92   /* Initialise all generations */
  93   for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
  94     gen = &generations[g];
  95     gen->no = g;
  96     gen->mut_list = END_MUT_LIST;
  97     gen->mut_once_list = END_MUT_LIST;
  98     gen->collections = 0;
  99     gen->failed_promotions = 0;
 100     gen->max_blocks = 0;
 101   }
 102
 103   /* A couple of convenience pointers */
 104   g0 = &generations[0];
 105   oldest_gen = &generations[RtsFlags.GcFlags.generations-1];
 106
 107   /* Allocate step structures in each generation */
 108   if (RtsFlags.GcFlags.generations > 1) {
 109     /* Only for multiple-generations */
 110
 111     /* Oldest generation: one step */
 112     oldest_gen->n_steps = 1;
 113     oldest_gen->steps =
 114       stgMallocBytes(1 * sizeof(struct _step), "initStorage: last step");
 115
 116     /* set up all except the oldest generation with 2 steps */
 117     for(g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
 118       generations[g].n_steps = RtsFlags.GcFlags.steps;
 119       generations[g].steps  =
 120         stgMallocBytes (RtsFlags.GcFlags.steps * sizeof(struct _step),
 121                         "initStorage: steps");
 122     }
 123
 124   } else {
 125     /* single generation, i.e. a two-space collector */
 126     g0->n_steps = 1;
 127     g0->steps = stgMallocBytes (sizeof(struct _step), "initStorage: steps");
 128   }
 129
 130   /* Initialise all steps */
 131   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 132     for (s = 0; s < generations[g].n_steps; s++) {
 133       stp = &generations[g].steps[s];
 134       stp->no = s;
 135       stp->blocks = NULL;
 136       stp->n_blocks = 0;
 137       stp->gen = &generations[g];
 138       stp->hp = NULL;
 139       stp->hpLim = NULL;
 140       stp->hp_bd = NULL;
 141       stp->scan = NULL;
 142       stp->scan_bd = NULL;
 143       stp->large_objects = NULL;
 144       stp->new_large_objects = NULL;
 145       stp->scavenged_large_objects = NULL;
 146     }
 147   }
 148
 149   /* Set up the destination pointers in each younger gen. step */
 150   for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
 151     for (s = 0; s < generations[g].n_steps-1; s++) {
 152       generations[g].steps[s].to = &generations[g].steps[s+1];
 153     }
 154     generations[g].steps[s].to = &generations[g+1].steps[0];
 155   }
 156
 157   /* The oldest generation has one step and its destination is the
 158    * same step. */
 159   oldest_gen->steps[0].to = &oldest_gen->steps[0];
 160
 161   /* generation 0 is special: that's the nursery */
 162   generations[0].max_blocks = 0;
 163
 164   /* G0S0: the allocation area.  Policy: keep the allocation area
 165    * small to begin with, even if we have a large suggested heap
 166    * size.  Reason: we're going to do a major collection first, and we
 167    * don't want it to be a big one.  This vague idea is borne out by
 168    * rigorous experimental evidence.
 169    */
 170   g0s0 = &generations[0].steps[0];
 171
 172   allocNurseries();
 173
 174   weak_ptr_list = NULL;
 175   caf_list = NULL;
 176
 177   /* initialise the allocate() interface */
 178   small_alloc_list = NULL;
 179   large_alloc_list = NULL;
 180   alloc_blocks = 0;
 181   alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
 182
 183   /* Tell GNU multi-precision pkg about our custom alloc functions */
 184   mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
 185
 186 #ifdef SMP
 187   pthread_mutex_init(&sm_mutex, NULL);
 188 #endif
 189
 190   IF_DEBUG(gc, stat_describe_gens());
 191 }
 192
 193 void
 194 exitStorage (void)
 195 {
 196     stat_exit(calcAllocated());
 197 }
 198
 199 /* -----------------------------------------------------------------------------
 200    CAF management.
 201    -------------------------------------------------------------------------- */
 202
 203 void
 204 newCAF(StgClosure* caf)
 205 {
 206   /* Put this CAF on the mutable list for the old generation.
 207    * This is a HACK - the IND_STATIC closure doesn't really have
 208    * a mut_link field, but we pretend it has - in fact we re-use
 209    * the STATIC_LINK field for the time being, because when we
 210    * come to do a major GC we won't need the mut_link field
 211    * any more and can use it as a STATIC_LINK.
 212    */
 213   ACQUIRE_LOCK(&sm_mutex);
 214
 215   ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
 216   ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
 217   oldest_gen->mut_once_list = (StgMutClosure *)caf;
 218
 219 #ifdef GHCI
 220   /* For dynamically-loaded code, we retain all the CAFs.  There is no
 221    * way of knowing which ones we'll need in the future.
 222    */
 223   if (is_dynamically_loaded_rwdata_ptr((StgPtr)caf)) {
 224       caf->payload[2] = caf_list; /* IND_STATIC_LINK2() */
 225       caf_list = caf;
 226   }
 227 #endif
 228
 229 #ifdef INTERPRETER
 230   /* If we're Hugs, we also have to put it in the CAF table, so that
 231      the CAF can be reverted.  When reverting, CAFs created by compiled
 232      code are recorded in the CAF table, which lives outside the
 233      heap, in mallocville.  CAFs created by interpreted code are
 234      chained together via the link fields in StgCAFs, and are not
 235      recorded in the CAF table.
 236   */
 237   ASSERT( get_itbl(caf)->type == THUNK_STATIC );
 238   addToECafTable ( caf, get_itbl(caf) );
 239 #endif
 240
 241   RELEASE_LOCK(&sm_mutex);
 242 }
 243
 244 #ifdef GHCI
 245 void
 246 markCafs( void )
 247 {
 248     StgClosure *p;
 249
 250     for (p = caf_list; p != NULL; p = STATIC_LINK2(get_itbl(p),p)) {
 251         MarkRoot(p);
 252     }
 253 }
 254 #endif /* GHCI */
 255
 256 #ifdef INTERPRETER
 257 void
 258 newCAF_made_by_Hugs(StgCAF* caf)
 259 {
 260   ACQUIRE_LOCK(&sm_mutex);
 261
 262   ASSERT( get_itbl(caf)->type == CAF_ENTERED );
 263   recordOldToNewPtrs((StgMutClosure*)caf);
 264   caf->link = ecafList;
 265   ecafList = caf->link;
 266
 267   RELEASE_LOCK(&sm_mutex);
 268 }
 269 #endif
 270
 271 #ifdef INTERPRETER
 272 /* These initialisations are critical for correct operation
 273    on the first call of addToECafTable.
 274 */
 275 StgCAF*         ecafList      = END_ECAF_LIST;
 276 StgCAFTabEntry* ecafTable     = NULL;
 277 StgInt          usedECafTable = 0;
 278 StgInt          sizeECafTable = 0;
 279
 280
 281 void clearECafTable ( void )
 282 {
 283    usedECafTable = 0;
 284 }
 285
 286 void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl )
 287 {
 288    StgInt          i;
 289    StgCAFTabEntry* et2;
 290    if (usedECafTable == sizeECafTable) {
 291       /* Make the initial table size be 8 */
 292       sizeECafTable *= 2;
 293       if (sizeECafTable == 0) sizeECafTable = 8;
 294       et2 = stgMallocBytes (
 295                sizeECafTable * sizeof(StgCAFTabEntry),
 296                "addToECafTable" );
 297       for (i = 0; i < usedECafTable; i++)
 298          et2[i] = ecafTable[i];
 299       if (ecafTable) free(ecafTable);
 300       ecafTable = et2;
 301    }
 302    ecafTable[usedECafTable].closure  = closure;
 303    ecafTable[usedECafTable].origItbl = origItbl;
 304    usedECafTable++;
 305 }
 306 #endif
 307
 308 /* -----------------------------------------------------------------------------
 309    Nursery management.
 310    -------------------------------------------------------------------------- */
 311
 312 void
 313 allocNurseries( void )
 314 {
 315 #ifdef SMP
 316   {
 317     Capability *cap;
 318     bdescr *bd;
 319
 320     g0s0->blocks = NULL;
 321     g0s0->n_blocks = 0;
 322     for (cap = free_capabilities; cap != NULL; cap = cap->link) {
 323       cap->rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
 324       cap->rCurrentNursery = cap->rNursery;
 325       for (bd = cap->rNursery; bd != NULL; bd = bd->link) {
 326         bd->back = (bdescr *)cap;
 327       }
 328     }
 329     /* Set the back links to be equal to the Capability,
 330      * so we can do slightly better informed locking.
 331      */
 332   }
 333 #else /* SMP */
 334   nursery_blocks  = RtsFlags.GcFlags.minAllocAreaSize;
 335   g0s0->blocks    = allocNursery(NULL, nursery_blocks);
 336   g0s0->n_blocks  = nursery_blocks;
 337   g0s0->to_space  = NULL;
 338   MainRegTable.rNursery        = g0s0->blocks;
 339   MainRegTable.rCurrentNursery = g0s0->blocks;
 340   /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
 341 #endif
 342 }
 343
 344 void
 345 resetNurseries( void )
 346 {
 347   bdescr *bd;
 348 #ifdef SMP
 349   Capability *cap;
 350
 351   /* All tasks must be stopped */
 352   ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes);
 353
 354   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
 355     for (bd = cap->rNursery; bd; bd = bd->link) {
 356       bd->free = bd->start;
 357       ASSERT(bd->gen == g0);
 358       ASSERT(bd->step == g0s0);
 359       IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
 360     }
 361     cap->rCurrentNursery = cap->rNursery;
 362   }
 363 #else
 364   for (bd = g0s0->blocks; bd; bd = bd->link) {
 365     bd->free = bd->start;
 366     ASSERT(bd->gen == g0);
 367     ASSERT(bd->step == g0s0);
 368     IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
 369   }
 370   MainRegTable.rNursery = g0s0->blocks;
 371   MainRegTable.rCurrentNursery = g0s0->blocks;
 372 #endif
 373 }
 374
 375 bdescr *
 376 allocNursery (bdescr *last_bd, nat blocks)
 377 {
 378   bdescr *bd;
 379   nat i;
 380
 381   /* Allocate a nursery */
 382   for (i=0; i < blocks; i++) {
 383     bd = allocBlock();
 384     bd->link = last_bd;
 385     bd->step = g0s0;
 386     bd->gen = g0;
 387     bd->evacuated = 0;
 388     bd->free = bd->start;
 389     last_bd = bd;
 390   }
 391   return last_bd;
 392 }
 393
 394 void
 395 resizeNursery ( nat blocks )
 396 {
 397   bdescr *bd;
 398
 399 #ifdef SMP
 400   barf("resizeNursery: can't resize in SMP mode");
 401 #endif
 402
 403   if (nursery_blocks == blocks) {
 404     ASSERT(g0s0->n_blocks == blocks);
 405     return;
 406   }
 407
 408   else if (nursery_blocks < blocks) {
 409     IF_DEBUG(gc, fprintf(stderr, "Increasing size of nursery to %d blocks\n",
 410                          blocks));
 411     g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
 412   }
 413
 414   else {
 415     bdescr *next_bd;
 416
 417     IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n",
 418                          blocks));
 419     for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
 420       next_bd = bd->link;
 421       freeGroup(bd);
 422       bd = next_bd;
 423     }
 424     g0s0->blocks = bd;
 425   }
 426
 427   g0s0->n_blocks = nursery_blocks = blocks;
 428 }
 429
 430 /* -----------------------------------------------------------------------------
 431    The allocate() interface
 432
 433    allocate(n) always succeeds, and returns a chunk of memory n words
 434    long.  n can be larger than the size of a block if necessary, in
 435    which case a contiguous block group will be allocated.
 436    -------------------------------------------------------------------------- */
 437
 438 StgPtr
 439 allocate(nat n)
 440 {
 441   bdescr *bd;
 442   StgPtr p;
 443
 444   ACQUIRE_LOCK(&sm_mutex);
 445
 446   TICK_ALLOC_HEAP_NOCTR(n);
 447   CCS_ALLOC(CCCS,n);
 448
 449   /* big allocation (>LARGE_OBJECT_THRESHOLD) */
 450   /* ToDo: allocate directly into generation 1 */
 451   if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
 452     nat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
 453     bd = allocGroup(req_blocks);
 454     dbl_link_onto(bd, &g0s0->large_objects);
 455     bd->gen  = g0;
 456     bd->step = g0s0;
 457     bd->evacuated = 0;
 458     bd->free = bd->start;
 459     /* don't add these blocks to alloc_blocks, since we're assuming
 460      * that large objects are likely to remain live for quite a while
 461      * (eg. running threads), so garbage collecting early won't make
 462      * much difference.
 463      */
 464     alloc_blocks += req_blocks;
 465     RELEASE_LOCK(&sm_mutex);
 466     return bd->start;
 467
 468   /* small allocation (<LARGE_OBJECT_THRESHOLD) */
 469   } else if (small_alloc_list == NULL || alloc_Hp + n > alloc_HpLim) {
 470     if (small_alloc_list) {
 471       small_alloc_list->free = alloc_Hp;
 472     }
 473     bd = allocBlock();
 474     bd->link = small_alloc_list;
 475     small_alloc_list = bd;
 476     bd->gen = g0;
 477     bd->step = g0s0;
 478     bd->evacuated = 0;
 479     alloc_Hp = bd->start;
 480     alloc_HpLim = bd->start + BLOCK_SIZE_W;
 481     alloc_blocks++;
 482   }
 483
 484   p = alloc_Hp;
 485   alloc_Hp += n;
 486   RELEASE_LOCK(&sm_mutex);
 487   return p;
 488 }
 489
 490 lnat allocated_bytes(void)
 491 {
 492   return (alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp));
 493 }
 494
 495 /* -----------------------------------------------------------------------------
 496    Allocation functions for GMP.
 497
 498    These all use the allocate() interface - we can't have any garbage
 499    collection going on during a gmp operation, so we use allocate()
 500    which always succeeds.  The gmp operations which might need to
 501    allocate will ask the storage manager (via doYouWantToGC()) whether
 502    a garbage collection is required, in case we get into a loop doing
 503    only allocate() style allocation.
 504    -------------------------------------------------------------------------- */
 505
 506 static void *
 507 stgAllocForGMP (size_t size_in_bytes)
 508 {
 509   StgArrWords* arr;
 510   nat data_size_in_words, total_size_in_words;
 511
 512   /* should be a multiple of sizeof(StgWord) (whole no. of limbs) */
 513   ASSERT(size_in_bytes % sizeof(W_) == 0);
 514
 515   data_size_in_words  = size_in_bytes / sizeof(W_);
 516   total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
 517
 518   /* allocate and fill it in. */
 519   arr = (StgArrWords *)allocate(total_size_in_words);
 520   SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
 521
 522   /* and return a ptr to the goods inside the array */
 523   return(BYTE_ARR_CTS(arr));
 524 }
 525
 526 static void *
 527 stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
 528 {
 529     void *new_stuff_ptr = stgAllocForGMP(new_size);
 530     nat i = 0;
 531     char *p = (char *) ptr;
 532     char *q = (char *) new_stuff_ptr;
 533
 534     for (; i < old_size; i++, p++, q++) {
 535         *q = *p;
 536     }
 537
 538     return(new_stuff_ptr);
 539 }
 540
 541 static void
 542 stgDeallocForGMP (void *ptr STG_UNUSED,
 543                   size_t size STG_UNUSED)
 544 {
 545     /* easy for us: the garbage collector does the dealloc'n */
 546 }
 547
 548 /* -----------------------------------------------------------------------------
 549  * Stats and stuff
 550  * -------------------------------------------------------------------------- */
 551
 552 /* -----------------------------------------------------------------------------
 553  * calcAllocated()
 554  *
 555  * Approximate how much we've allocated: number of blocks in the
 556  * nursery + blocks allocated via allocate() - unused nusery blocks.
 557  * This leaves a little slop at the end of each block, and doesn't
 558  * take into account large objects (ToDo).
 559  * -------------------------------------------------------------------------- */
 560
 561 lnat
 562 calcAllocated( void )
 563 {
 564   nat allocated;
 565   bdescr *bd;
 566
 567 #ifdef SMP
 568   Capability *cap;
 569
 570   /* All tasks must be stopped.  Can't assert that all the
 571      capabilities are owned by the scheduler, though: one or more
 572      tasks might have been stopped while they were running (non-main)
 573      threads. */
 574   /*  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes); */
 575
 576   allocated =
 577     n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
 578     + allocated_bytes();
 579
 580   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
 581     for ( bd = cap->rCurrentNursery->link; bd != NULL; bd = bd->link ) {
 582       allocated -= BLOCK_SIZE_W;
 583     }
 584     if (cap->rCurrentNursery->free < cap->rCurrentNursery->start
 585         + BLOCK_SIZE_W) {
 586       allocated -= (cap->rCurrentNursery->start + BLOCK_SIZE_W)
 587         - cap->rCurrentNursery->free;
 588     }
 589   }
 590
 591 #else /* !SMP */
 592   bdescr *current_nursery = MainRegTable.rCurrentNursery;
 593
 594   allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
 595   for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
 596     allocated -= BLOCK_SIZE_W;
 597   }
 598   if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
 599     allocated -= (current_nursery->start + BLOCK_SIZE_W)
 600       - current_nursery->free;
 601   }
 602 #endif
 603
 604   total_allocated += allocated;
 605   return allocated;
 606 }
 607
 608 /* Approximate the amount of live data in the heap.  To be called just
 609  * after garbage collection (see GarbageCollect()).
 610  */
 611 extern lnat
 612 calcLive(void)
 613 {
 614   nat g, s;
 615   lnat live = 0;
 616   step *stp;
 617
 618   if (RtsFlags.GcFlags.generations == 1) {
 619     live = (g0s0->to_blocks - 1) * BLOCK_SIZE_W +
 620       ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_);
 621     return live;
 622   }
 623
 624   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 625     for (s = 0; s < generations[g].n_steps; s++) {
 626       /* approximate amount of live data (doesn't take into account slop
 627        * at end of each block).
 628        */
 629       if (g == 0 && s == 0) {
 630           continue;
 631       }
 632       stp = &generations[g].steps[s];
 633       live += (stp->n_blocks - 1) * BLOCK_SIZE_W +
 634         ((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start) / sizeof(W_);
 635     }
 636   }
 637   return live;
 638 }
 639
 640 /* Approximate the number of blocks that will be needed at the next
 641  * garbage collection.
 642  *
 643  * Assume: all data currently live will remain live.  Steps that will
 644  * be collected next time will therefore need twice as many blocks
 645  * since all the data will be copied.
 646  */
 647 extern lnat
 648 calcNeeded(void)
 649 {
 650   lnat needed = 0;
 651   nat g, s;
 652   step *stp;
 653
 654   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 655     for (s = 0; s < generations[g].n_steps; s++) {
 656       if (g == 0 && s == 0) { continue; }
 657       stp = &generations[g].steps[s];
 658       if (generations[g].steps[0].n_blocks > generations[g].max_blocks) {
 659         needed += 2 * stp->n_blocks;
 660       } else {
 661         needed += stp->n_blocks;
 662       }
 663     }
 664   }
 665   return needed;
 666 }
 667
 668 /* -----------------------------------------------------------------------------
 669    Debugging
 670
 671    memInventory() checks for memory leaks by counting up all the
 672    blocks we know about and comparing that to the number of blocks
 673    allegedly floating around in the system.
 674    -------------------------------------------------------------------------- */
 675
 676 #ifdef DEBUG
 677
 678 extern void
 679 memInventory(void)
 680 {
 681   nat g, s;
 682   step *stp;
 683   bdescr *bd;
 684   lnat total_blocks = 0, free_blocks = 0;
 685
 686   /* count the blocks we current have */
 687
 688   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 689     for (s = 0; s < generations[g].n_steps; s++) {
 690       stp = &generations[g].steps[s];
 691       total_blocks += stp->n_blocks;
 692       if (RtsFlags.GcFlags.generations == 1) {
 693         /* two-space collector has a to-space too :-) */
 694         total_blocks += g0s0->to_blocks;
 695       }
 696       for (bd = stp->large_objects; bd; bd = bd->link) {
 697         total_blocks += bd->blocks;
 698         /* hack for megablock groups: they have an extra block or two in
 699            the second and subsequent megablocks where the block
 700            descriptors would normally go.
 701         */
 702         if (bd->blocks > BLOCKS_PER_MBLOCK) {
 703           total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
 704                           * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
 705         }
 706       }
 707     }
 708   }
 709
 710   /* any blocks held by allocate() */
 711   for (bd = small_alloc_list; bd; bd = bd->link) {
 712     total_blocks += bd->blocks;
 713   }
 714   for (bd = large_alloc_list; bd; bd = bd->link) {
 715     total_blocks += bd->blocks;
 716   }
 717
 718   /* count the blocks on the free list */
 719   free_blocks = countFreeList();
 720
 721   ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
 722
 723 #if 0
 724   if (total_blocks + free_blocks != mblocks_allocated *
 725       BLOCKS_PER_MBLOCK) {
 726     fprintf(stderr, "Blocks: %ld live + %ld free  = %ld total (%ld around)\n",
 727             total_blocks, free_blocks, total_blocks + free_blocks,
 728             mblocks_allocated * BLOCKS_PER_MBLOCK);
 729   }
 730 #endif
 731 }
 732
 733 /* Full heap sanity check. */
 734
 735 extern void
 736 checkSanity(nat N)
 737 {
 738   nat g, s;
 739
 740   if (RtsFlags.GcFlags.generations == 1) {
 741     checkHeap(g0s0->to_space, NULL);
 742     checkChain(g0s0->large_objects);
 743   } else {
 744
 745     for (g = 0; g <= N; g++) {
 746       for (s = 0; s < generations[g].n_steps; s++) {
 747         if (g == 0 && s == 0) { continue; }
 748         checkHeap(generations[g].steps[s].blocks, NULL);
 749       }
 750     }
 751     for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
 752       for (s = 0; s < generations[g].n_steps; s++) {
 753         checkHeap(generations[g].steps[s].blocks,
 754                   generations[g].steps[s].blocks->start);
 755         checkChain(generations[g].steps[s].large_objects);
 756       }
 757     }
 758     checkFreeListSanity();
 759   }
 760 }
 761
 762 #endif