ghc/rts/Storage.c

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