ghc/rts/Storage.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Storage.c,v 1.30 2000/12/11 12:37:00 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 *step;
  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       step = &generations[g].steps[s];
 134       step->no = s;
 135       step->blocks = NULL;
 136       step->n_blocks = 0;
 137       step->gen = &generations[g];
 138       step->hp = NULL;
 139       step->hpLim = NULL;
 140       step->hp_bd = NULL;
 141       step->scan = NULL;
 142       step->scan_bd = NULL;
 143       step->large_objects = NULL;
 144       step->new_large_objects = NULL;
 145       step->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    Setting the heap size.  This function is callable from Haskell (GHC
 201    uses it to implement the -H<size> option).
 202    -------------------------------------------------------------------------- */
 203
 204 void
 205 setHeapSize( HsInt size )
 206 {
 207     RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE;
 208     if (RtsFlags.GcFlags.heapSizeSuggestion >
 209         RtsFlags.GcFlags.maxHeapSize) {
 210         RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
 211     }
 212 }
 213
 214 /* -----------------------------------------------------------------------------
 215    CAF management.
 216    -------------------------------------------------------------------------- */
 217
 218 void
 219 newCAF(StgClosure* caf)
 220 {
 221   /* Put this CAF on the mutable list for the old generation.
 222    * This is a HACK - the IND_STATIC closure doesn't really have
 223    * a mut_link field, but we pretend it has - in fact we re-use
 224    * the STATIC_LINK field for the time being, because when we
 225    * come to do a major GC we won't need the mut_link field
 226    * any more and can use it as a STATIC_LINK.
 227    */
 228   ACQUIRE_LOCK(&sm_mutex);
 229
 230   ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
 231   ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
 232   oldest_gen->mut_once_list = (StgMutClosure *)caf;
 233
 234 #ifdef INTERPRETER
 235   /* If we're Hugs, we also have to put it in the CAF table, so that
 236      the CAF can be reverted.  When reverting, CAFs created by compiled
 237      code are recorded in the CAF table, which lives outside the
 238      heap, in mallocville.  CAFs created by interpreted code are
 239      chained together via the link fields in StgCAFs, and are not
 240      recorded in the CAF table.
 241   */
 242   ASSERT( get_itbl(caf)->type == THUNK_STATIC );
 243   addToECafTable ( caf, get_itbl(caf) );
 244 #endif
 245
 246   RELEASE_LOCK(&sm_mutex);
 247 }
 248
 249 #ifdef INTERPRETER
 250 void
 251 newCAF_made_by_Hugs(StgCAF* caf)
 252 {
 253   ACQUIRE_LOCK(&sm_mutex);
 254
 255   ASSERT( get_itbl(caf)->type == CAF_ENTERED );
 256   recordOldToNewPtrs((StgMutClosure*)caf);
 257   caf->link = ecafList;
 258   ecafList = caf->link;
 259
 260   RELEASE_LOCK(&sm_mutex);
 261 }
 262 #endif
 263
 264 #ifdef INTERPRETER
 265 /* These initialisations are critical for correct operation
 266    on the first call of addToECafTable.
 267 */
 268 StgCAF*         ecafList      = END_ECAF_LIST;
 269 StgCAFTabEntry* ecafTable     = NULL;
 270 StgInt          usedECafTable = 0;
 271 StgInt          sizeECafTable = 0;
 272
 273
 274 void clearECafTable ( void )
 275 {
 276    usedECafTable = 0;
 277 }
 278
 279 void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl )
 280 {
 281    StgInt          i;
 282    StgCAFTabEntry* et2;
 283    if (usedECafTable == sizeECafTable) {
 284       /* Make the initial table size be 8 */
 285       sizeECafTable *= 2;
 286       if (sizeECafTable == 0) sizeECafTable = 8;
 287       et2 = stgMallocBytes (
 288                sizeECafTable * sizeof(StgCAFTabEntry),
 289                "addToECafTable" );
 290       for (i = 0; i < usedECafTable; i++)
 291          et2[i] = ecafTable[i];
 292       if (ecafTable) free(ecafTable);
 293       ecafTable = et2;
 294    }
 295    ecafTable[usedECafTable].closure  = closure;
 296    ecafTable[usedECafTable].origItbl = origItbl;
 297    usedECafTable++;
 298 }
 299 #endif
 300
 301 /* -----------------------------------------------------------------------------
 302    Nursery management.
 303    -------------------------------------------------------------------------- */
 304
 305 void
 306 allocNurseries( void )
 307 {
 308 #ifdef SMP
 309   {
 310     Capability *cap;
 311     bdescr *bd;
 312
 313     g0s0->blocks = NULL;
 314     g0s0->n_blocks = 0;
 315     for (cap = free_capabilities; cap != NULL; cap = cap->link) {
 316       cap->rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
 317       cap->rCurrentNursery = cap->rNursery;
 318       for (bd = cap->rNursery; bd != NULL; bd = bd->link) {
 319         bd->back = (bdescr *)cap;
 320       }
 321     }
 322     /* Set the back links to be equal to the Capability,
 323      * so we can do slightly better informed locking.
 324      */
 325   }
 326 #else /* SMP */
 327   nursery_blocks  = RtsFlags.GcFlags.minAllocAreaSize;
 328   g0s0->blocks    = allocNursery(NULL, nursery_blocks);
 329   g0s0->n_blocks  = nursery_blocks;
 330   g0s0->to_space  = NULL;
 331   MainRegTable.rNursery        = g0s0->blocks;
 332   MainRegTable.rCurrentNursery = g0s0->blocks;
 333   /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
 334 #endif
 335 }
 336
 337 void
 338 resetNurseries( void )
 339 {
 340   bdescr *bd;
 341 #ifdef SMP
 342   Capability *cap;
 343
 344   /* All tasks must be stopped */
 345   ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes);
 346
 347   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
 348     for (bd = cap->rNursery; bd; bd = bd->link) {
 349       bd->free = bd->start;
 350       ASSERT(bd->gen == g0);
 351       ASSERT(bd->step == g0s0);
 352       IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
 353     }
 354     cap->rCurrentNursery = cap->rNursery;
 355   }
 356 #else
 357   for (bd = g0s0->blocks; bd; bd = bd->link) {
 358     bd->free = bd->start;
 359     ASSERT(bd->gen == g0);
 360     ASSERT(bd->step == g0s0);
 361     IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
 362   }
 363   MainRegTable.rNursery = g0s0->blocks;
 364   MainRegTable.rCurrentNursery = g0s0->blocks;
 365 #endif
 366 }
 367
 368 bdescr *
 369 allocNursery (bdescr *last_bd, nat blocks)
 370 {
 371   bdescr *bd;
 372   nat i;
 373
 374   /* Allocate a nursery */
 375   for (i=0; i < blocks; i++) {
 376     bd = allocBlock();
 377     bd->link = last_bd;
 378     bd->step = g0s0;
 379     bd->gen = g0;
 380     bd->evacuated = 0;
 381     bd->free = bd->start;
 382     last_bd = bd;
 383   }
 384   return last_bd;
 385 }
 386
 387 void
 388 resizeNursery ( nat blocks )
 389 {
 390   bdescr *bd;
 391
 392 #ifdef SMP
 393   barf("resizeNursery: can't resize in SMP mode");
 394 #endif
 395
 396   if (nursery_blocks == blocks) {
 397     ASSERT(g0s0->n_blocks == blocks);
 398     return;
 399   }
 400
 401   else if (nursery_blocks < blocks) {
 402     IF_DEBUG(gc, fprintf(stderr, "Increasing size of nursery to %d blocks\n",
 403                          blocks));
 404     g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
 405   }
 406
 407   else {
 408     bdescr *next_bd;
 409
 410     IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n",
 411                          blocks));
 412     for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
 413       next_bd = bd->link;
 414       freeGroup(bd);
 415       bd = next_bd;
 416     }
 417     g0s0->blocks = bd;
 418   }
 419
 420   g0s0->n_blocks = nursery_blocks = blocks;
 421 }
 422
 423 /* -----------------------------------------------------------------------------
 424    The allocate() interface
 425
 426    allocate(n) always succeeds, and returns a chunk of memory n words
 427    long.  n can be larger than the size of a block if necessary, in
 428    which case a contiguous block group will be allocated.
 429    -------------------------------------------------------------------------- */
 430
 431 StgPtr
 432 allocate(nat n)
 433 {
 434   bdescr *bd;
 435   StgPtr p;
 436
 437   ACQUIRE_LOCK(&sm_mutex);
 438
 439   TICK_ALLOC_HEAP_NOCTR(n);
 440   CCS_ALLOC(CCCS,n);
 441
 442   /* big allocation (>LARGE_OBJECT_THRESHOLD) */
 443   /* ToDo: allocate directly into generation 1 */
 444   if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
 445     nat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
 446     bd = allocGroup(req_blocks);
 447     dbl_link_onto(bd, &g0s0->large_objects);
 448     bd->gen  = g0;
 449     bd->step = g0s0;
 450     bd->evacuated = 0;
 451     bd->free = bd->start;
 452     /* don't add these blocks to alloc_blocks, since we're assuming
 453      * that large objects are likely to remain live for quite a while
 454      * (eg. running threads), so garbage collecting early won't make
 455      * much difference.
 456      */
 457     alloc_blocks += req_blocks;
 458     RELEASE_LOCK(&sm_mutex);
 459     return bd->start;
 460
 461   /* small allocation (<LARGE_OBJECT_THRESHOLD) */
 462   } else if (small_alloc_list == NULL || alloc_Hp + n > alloc_HpLim) {
 463     if (small_alloc_list) {
 464       small_alloc_list->free = alloc_Hp;
 465     }
 466     bd = allocBlock();
 467     bd->link = small_alloc_list;
 468     small_alloc_list = bd;
 469     bd->gen = g0;
 470     bd->step = g0s0;
 471     bd->evacuated = 0;
 472     alloc_Hp = bd->start;
 473     alloc_HpLim = bd->start + BLOCK_SIZE_W;
 474     alloc_blocks++;
 475   }
 476
 477   p = alloc_Hp;
 478   alloc_Hp += n;
 479   RELEASE_LOCK(&sm_mutex);
 480   return p;
 481 }
 482
 483 lnat allocated_bytes(void)
 484 {
 485   return (alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp));
 486 }
 487
 488 /* -----------------------------------------------------------------------------
 489    Allocation functions for GMP.
 490
 491    These all use the allocate() interface - we can't have any garbage
 492    collection going on during a gmp operation, so we use allocate()
 493    which always succeeds.  The gmp operations which might need to
 494    allocate will ask the storage manager (via doYouWantToGC()) whether
 495    a garbage collection is required, in case we get into a loop doing
 496    only allocate() style allocation.
 497    -------------------------------------------------------------------------- */
 498
 499 static void *
 500 stgAllocForGMP (size_t size_in_bytes)
 501 {
 502   StgArrWords* arr;
 503   nat data_size_in_words, total_size_in_words;
 504
 505   /* should be a multiple of sizeof(StgWord) (whole no. of limbs) */
 506   ASSERT(size_in_bytes % sizeof(W_) == 0);
 507
 508   data_size_in_words  = size_in_bytes / sizeof(W_);
 509   total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
 510
 511   /* allocate and fill it in. */
 512   arr = (StgArrWords *)allocate(total_size_in_words);
 513   SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
 514
 515   /* and return a ptr to the goods inside the array */
 516   return(BYTE_ARR_CTS(arr));
 517 }
 518
 519 static void *
 520 stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
 521 {
 522     void *new_stuff_ptr = stgAllocForGMP(new_size);
 523     nat i = 0;
 524     char *p = (char *) ptr;
 525     char *q = (char *) new_stuff_ptr;
 526
 527     for (; i < old_size; i++, p++, q++) {
 528         *q = *p;
 529     }
 530
 531     return(new_stuff_ptr);
 532 }
 533
 534 static void
 535 stgDeallocForGMP (void *ptr STG_UNUSED,
 536                   size_t size STG_UNUSED)
 537 {
 538     /* easy for us: the garbage collector does the dealloc'n */
 539 }
 540
 541 /* -----------------------------------------------------------------------------
 542  * Stats and stuff
 543  * -------------------------------------------------------------------------- */
 544
 545 /* -----------------------------------------------------------------------------
 546  * calcAllocated()
 547  *
 548  * Approximate how much we've allocated: number of blocks in the
 549  * nursery + blocks allocated via allocate() - unused nusery blocks.
 550  * This leaves a little slop at the end of each block, and doesn't
 551  * take into account large objects (ToDo).
 552  * -------------------------------------------------------------------------- */
 553
 554 lnat
 555 calcAllocated( void )
 556 {
 557   nat allocated;
 558   bdescr *bd;
 559
 560 #ifdef SMP
 561   Capability *cap;
 562
 563   /* All tasks must be stopped.  Can't assert that all the
 564      capabilities are owned by the scheduler, though: one or more
 565      tasks might have been stopped while they were running (non-main)
 566      threads. */
 567   /*  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes); */
 568
 569   allocated =
 570     n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
 571     + allocated_bytes();
 572
 573   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
 574     for ( bd = cap->rCurrentNursery->link; bd != NULL; bd = bd->link ) {
 575       allocated -= BLOCK_SIZE_W;
 576     }
 577     if (cap->rCurrentNursery->free < cap->rCurrentNursery->start
 578         + BLOCK_SIZE_W) {
 579       allocated -= (cap->rCurrentNursery->start + BLOCK_SIZE_W)
 580         - cap->rCurrentNursery->free;
 581     }
 582   }
 583
 584 #else /* !SMP */
 585   bdescr *current_nursery = MainRegTable.rCurrentNursery;
 586
 587   allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
 588   for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
 589     allocated -= BLOCK_SIZE_W;
 590   }
 591   if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
 592     allocated -= (current_nursery->start + BLOCK_SIZE_W)
 593       - current_nursery->free;
 594   }
 595 #endif
 596
 597   total_allocated += allocated;
 598   return allocated;
 599 }
 600
 601 /* Approximate the amount of live data in the heap.  To be called just
 602  * after garbage collection (see GarbageCollect()).
 603  */
 604 extern lnat
 605 calcLive(void)
 606 {
 607   nat g, s;
 608   lnat live = 0;
 609   step *step;
 610
 611   if (RtsFlags.GcFlags.generations == 1) {
 612     live = (g0s0->to_blocks - 1) * BLOCK_SIZE_W +
 613       ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_);
 614     return live;
 615   }
 616
 617   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 618     for (s = 0; s < generations[g].n_steps; s++) {
 619       /* approximate amount of live data (doesn't take into account slop
 620        * at end of each block).
 621        */
 622       if (g == 0 && s == 0) {
 623           continue;
 624       }
 625       step = &generations[g].steps[s];
 626       live += (step->n_blocks - 1) * BLOCK_SIZE_W +
 627         ((lnat)step->hp_bd->free - (lnat)step->hp_bd->start) / sizeof(W_);
 628     }
 629   }
 630   return live;
 631 }
 632
 633 /* Approximate the number of blocks that will be needed at the next
 634  * garbage collection.
 635  *
 636  * Assume: all data currently live will remain live.  Steps that will
 637  * be collected next time will therefore need twice as many blocks
 638  * since all the data will be copied.
 639  */
 640 extern lnat
 641 calcNeeded(void)
 642 {
 643   lnat needed = 0;
 644   nat g, s;
 645   step *step;
 646
 647   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 648     for (s = 0; s < generations[g].n_steps; s++) {
 649       if (g == 0 && s == 0) { continue; }
 650       step = &generations[g].steps[s];
 651       if (generations[g].steps[0].n_blocks > generations[g].max_blocks) {
 652         needed += 2 * step->n_blocks;
 653       } else {
 654         needed += step->n_blocks;
 655       }
 656     }
 657   }
 658   return needed;
 659 }
 660
 661 /* -----------------------------------------------------------------------------
 662    Debugging
 663
 664    memInventory() checks for memory leaks by counting up all the
 665    blocks we know about and comparing that to the number of blocks
 666    allegedly floating around in the system.
 667    -------------------------------------------------------------------------- */
 668
 669 #ifdef DEBUG
 670
 671 extern void
 672 memInventory(void)
 673 {
 674   nat g, s;
 675   step *step;
 676   bdescr *bd;
 677   lnat total_blocks = 0, free_blocks = 0;
 678
 679   /* count the blocks we current have */
 680
 681   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 682     for (s = 0; s < generations[g].n_steps; s++) {
 683       step = &generations[g].steps[s];
 684       total_blocks += step->n_blocks;
 685       if (RtsFlags.GcFlags.generations == 1) {
 686         /* two-space collector has a to-space too :-) */
 687         total_blocks += g0s0->to_blocks;
 688       }
 689       for (bd = step->large_objects; bd; bd = bd->link) {
 690         total_blocks += bd->blocks;
 691         /* hack for megablock groups: they have an extra block or two in
 692            the second and subsequent megablocks where the block
 693            descriptors would normally go.
 694         */
 695         if (bd->blocks > BLOCKS_PER_MBLOCK) {
 696           total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
 697                           * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
 698         }
 699       }
 700     }
 701   }
 702
 703   /* any blocks held by allocate() */
 704   for (bd = small_alloc_list; bd; bd = bd->link) {
 705     total_blocks += bd->blocks;
 706   }
 707   for (bd = large_alloc_list; bd; bd = bd->link) {
 708     total_blocks += bd->blocks;
 709   }
 710
 711   /* count the blocks on the free list */
 712   free_blocks = countFreeList();
 713
 714   ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
 715
 716 #if 0
 717   if (total_blocks + free_blocks != mblocks_allocated *
 718       BLOCKS_PER_MBLOCK) {
 719     fprintf(stderr, "Blocks: %ld live + %ld free  = %ld total (%ld around)\n",
 720             total_blocks, free_blocks, total_blocks + free_blocks,
 721             mblocks_allocated * BLOCKS_PER_MBLOCK);
 722   }
 723 #endif
 724 }
 725
 726 /* Full heap sanity check. */
 727
 728 extern void
 729 checkSanity(nat N)
 730 {
 731   nat g, s;
 732
 733   if (RtsFlags.GcFlags.generations == 1) {
 734     checkHeap(g0s0->to_space, NULL);
 735     checkChain(g0s0->large_objects);
 736   } else {
 737
 738     for (g = 0; g <= N; g++) {
 739       for (s = 0; s < generations[g].n_steps; s++) {
 740         if (g == 0 && s == 0) { continue; }
 741         checkHeap(generations[g].steps[s].blocks, NULL);
 742       }
 743     }
 744     for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
 745       for (s = 0; s < generations[g].n_steps; s++) {
 746         checkHeap(generations[g].steps[s].blocks,
 747                   generations[g].steps[s].blocks->start);
 748         checkChain(generations[g].steps[s].large_objects);
 749       }
 750     }
 751     checkFreeListSanity();
 752   }
 753 }
 754
 755 #endif