ghc/rts/Storage.c

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