Storage.c 20.4 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
 * $Id: Storage.c,v 1.32 2001/01/16 12:02:04 simonmar Exp $
3 4
 *
 * (c) The GHC Team, 1998-1999
5 6 7 8 9 10 11 12 13 14 15
 *
 * Storage manager front end
 *
 * ---------------------------------------------------------------------------*/

#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
#include "Stats.h"
#include "Hooks.h"
#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 23
#include "StoragePriv.h"

24
#ifndef SMP
25
nat nursery_blocks;		/* number of blocks in the nursery */
26
#endif
27 28 29 30 31 32 33 34 35 36 37

StgClosure    *caf_list         = NULL;

bdescr *small_alloc_list;	/* allocate()d small objects */
bdescr *large_alloc_list;	/* allocate()d large objects */
nat alloc_blocks;		/* number of allocate()d blocks since GC */
nat alloc_blocks_lim;		/* approximate limit on alloc_blocks */

StgPtr alloc_Hp    = NULL;	/* next free byte in small_alloc_list */
StgPtr alloc_HpLim = NULL;	/* end of block at small_alloc_list   */

38 39 40 41 42
generation *generations;	/* all the generations */
generation *g0;			/* generation 0, for convenience */
generation *oldest_gen;		/* oldest generation, for convenience */
step *g0s0;			/* generation 0, step 0, for convenience */

43 44
lnat total_allocated = 0;	/* total memory allocated during run */

45 46 47 48 49 50 51 52
/*
 * Storage manager mutex:  protects all the above state from
 * simultaneous access by two STG threads.
 */
#ifdef SMP
pthread_mutex_t sm_mutex = PTHREAD_MUTEX_INITIALIZER;
#endif

53 54 55 56 57 58 59 60 61 62
/*
 * Forward references
 */
static void *stgAllocForGMP   (size_t size_in_bytes);
static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
static void  stgDeallocForGMP (void *ptr, size_t size);

void
initStorage (void)
{
63
  nat g, s;
64
  step *stp;
65
  generation *gen;
66

67 68 69 70 71 72 73 74 75 76 77 78 79
  /* If we're doing heap profiling, we want a two-space heap with a
   * fixed-size allocation area so that we get roughly even-spaced
   * samples.
   */
#if defined(PROFILING) || defined(DEBUG)
  if (RtsFlags.ProfFlags.doHeapProfile) {
    RtsFlags.GcFlags.generations = 1;
    RtsFlags.GcFlags.steps = 1;
    RtsFlags.GcFlags.oldGenFactor = 0;
    RtsFlags.GcFlags.heapSizeSuggestion = 0;
  }
#endif

80 81
  if (RtsFlags.GcFlags.heapSizeSuggestion > 
      RtsFlags.GcFlags.maxHeapSize) {
82
    RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
83 84
  }

85 86
  initBlockAllocator();
  
87 88 89 90 91
  /* allocate generation info array */
  generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations 
					     * sizeof(struct _generation),
					     "initStorage: gens");

92
  /* Initialise all generations */
93
  for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
94 95 96
    gen = &generations[g];
    gen->no = g;
    gen->mut_list = END_MUT_LIST;
97
    gen->mut_once_list = END_MUT_LIST;
98 99
    gen->collections = 0;
    gen->failed_promotions = 0;
100
    gen->max_blocks = 0;
101 102
  }

103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
  /* A couple of convenience pointers */
  g0 = &generations[0];
  oldest_gen = &generations[RtsFlags.GcFlags.generations-1];

  /* Allocate step structures in each generation */
  if (RtsFlags.GcFlags.generations > 1) {
    /* Only for multiple-generations */

    /* Oldest generation: one step */
    oldest_gen->n_steps = 1;
    oldest_gen->steps = 
      stgMallocBytes(1 * sizeof(struct _step), "initStorage: last step");

    /* set up all except the oldest generation with 2 steps */
    for(g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
118 119 120 121
      generations[g].n_steps = RtsFlags.GcFlags.steps;
      generations[g].steps  = 
	stgMallocBytes (RtsFlags.GcFlags.steps * sizeof(struct _step),
			"initStorage: steps");
122 123 124 125 126 127
    }
    
  } else {
    /* single generation, i.e. a two-space collector */
    g0->n_steps = 1;
    g0->steps = stgMallocBytes (sizeof(struct _step), "initStorage: steps");
128 129
  }

130 131
  /* Initialise all steps */
  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
132
    for (s = 0; s < generations[g].n_steps; s++) {
133 134 135 136 137 138 139 140 141 142 143 144 145
      stp = &generations[g].steps[s];
      stp->no = s;
      stp->blocks = NULL;
      stp->n_blocks = 0;
      stp->gen = &generations[g];
      stp->hp = NULL;
      stp->hpLim = NULL;
      stp->hp_bd = NULL;
      stp->scan = NULL;
      stp->scan_bd = NULL;
      stp->large_objects = NULL;
      stp->new_large_objects = NULL;
      stp->scavenged_large_objects = NULL;
146 147 148
    }
  }
  
149 150
  /* Set up the destination pointers in each younger gen. step */
  for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
151 152
    for (s = 0; s < generations[g].n_steps-1; s++) {
      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 158 159
  }
  
  /* The oldest generation has one step and its destination is the
   * same step. */
  oldest_gen->steps[0].to = &oldest_gen->steps[0];
160 161 162 163

  /* generation 0 is special: that's the nursery */
  generations[0].max_blocks = 0;

164 165 166 167 168 169
  /* G0S0: the allocation area.  Policy: keep the allocation area
   * small to begin with, even if we have a large suggested heap
   * size.  Reason: we're going to do a major collection first, and we
   * don't want it to be a big one.  This vague idea is borne out by 
   * rigorous experimental evidence.
   */
170 171 172
  g0s0 = &generations[0].steps[0];

  allocNurseries();
173 174 175 176 177 178 179 180 181 182 183 184

  weak_ptr_list = NULL;
  caf_list = NULL;
   
  /* initialise the allocate() interface */
  small_alloc_list = NULL;
  large_alloc_list = NULL;
  alloc_blocks = 0;
  alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;

  /* Tell GNU multi-precision pkg about our custom alloc functions */
  mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
185

186 187 188 189
#ifdef SMP
  pthread_mutex_init(&sm_mutex, NULL);
#endif

190
  IF_DEBUG(gc, stat_describe_gens());
191 192
}

193 194 195
void
exitStorage (void)
{
196
    stat_exit(calcAllocated());
197 198
}

199 200 201 202
/* -----------------------------------------------------------------------------
   CAF management.
   -------------------------------------------------------------------------- */

203 204 205 206 207 208 209 210 211 212 213
void
newCAF(StgClosure* caf)
{
  /* Put this CAF on the mutable list for the old generation.
   * This is a HACK - the IND_STATIC closure doesn't really have
   * a mut_link field, but we pretend it has - in fact we re-use
   * the STATIC_LINK field for the time being, because when we
   * come to do a major GC we won't need the mut_link field
   * any more and can use it as a STATIC_LINK.
   */
  ACQUIRE_LOCK(&sm_mutex);
214 215

  ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
216 217 218
  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
  oldest_gen->mut_once_list = (StgMutClosure *)caf;

219 220 221 222 223 224 225 226 227 228
#ifdef INTERPRETER
  /* If we're Hugs, we also have to put it in the CAF table, so that
     the CAF can be reverted.  When reverting, CAFs created by compiled
     code are recorded in the CAF table, which lives outside the
     heap, in mallocville.  CAFs created by interpreted code are
     chained together via the link fields in StgCAFs, and are not
     recorded in the CAF table.
  */
  ASSERT( get_itbl(caf)->type == THUNK_STATIC );
  addToECafTable ( caf, get_itbl(caf) );
229
#endif
230

231 232 233
  RELEASE_LOCK(&sm_mutex);
}

234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
#ifdef INTERPRETER
void
newCAF_made_by_Hugs(StgCAF* caf)
{
  ACQUIRE_LOCK(&sm_mutex);

  ASSERT( get_itbl(caf)->type == CAF_ENTERED );
  recordOldToNewPtrs((StgMutClosure*)caf);
  caf->link = ecafList;
  ecafList = caf->link;

  RELEASE_LOCK(&sm_mutex);
}
#endif

#ifdef INTERPRETER
/* These initialisations are critical for correct operation
   on the first call of addToECafTable. 
*/
StgCAF*         ecafList      = END_ECAF_LIST;
StgCAFTabEntry* ecafTable     = NULL;
StgInt          usedECafTable = 0;
StgInt          sizeECafTable = 0;


void clearECafTable ( void )
{
   usedECafTable = 0;
}

void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl )
{
   StgInt          i;
   StgCAFTabEntry* et2;
   if (usedECafTable == sizeECafTable) {
      /* Make the initial table size be 8 */
      sizeECafTable *= 2;
      if (sizeECafTable == 0) sizeECafTable = 8;
      et2 = stgMallocBytes ( 
               sizeECafTable * sizeof(StgCAFTabEntry),
               "addToECafTable" );
      for (i = 0; i < usedECafTable; i++) 
         et2[i] = ecafTable[i];
      if (ecafTable) free(ecafTable);
      ecafTable = et2;
   }
   ecafTable[usedECafTable].closure  = closure;
   ecafTable[usedECafTable].origItbl = origItbl;
   usedECafTable++;
}
#endif

286 287 288 289 290 291 292 293 294 295
/* -----------------------------------------------------------------------------
   Nursery management.
   -------------------------------------------------------------------------- */

void
allocNurseries( void )
{ 
#ifdef SMP
  {
    Capability *cap;
296 297
    bdescr *bd;

298 299 300 301 302
    g0s0->blocks = NULL;
    g0s0->n_blocks = 0;
    for (cap = free_capabilities; cap != NULL; cap = cap->link) {
      cap->rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
      cap->rCurrentNursery = cap->rNursery;
303 304 305
      for (bd = cap->rNursery; bd != NULL; bd = bd->link) {
	bd->back = (bdescr *)cap;
      }
306
    }
307 308 309
    /* Set the back links to be equal to the Capability,
     * so we can do slightly better informed locking.
     */
310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329
  }
#else /* SMP */
  nursery_blocks  = RtsFlags.GcFlags.minAllocAreaSize;
  g0s0->blocks    = allocNursery(NULL, nursery_blocks);
  g0s0->n_blocks  = nursery_blocks;
  g0s0->to_space  = NULL;
  MainRegTable.rNursery        = g0s0->blocks;
  MainRegTable.rCurrentNursery = g0s0->blocks;
  /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
#endif
}
      
void
resetNurseries( void )
{
  bdescr *bd;
#ifdef SMP
  Capability *cap;
  
  /* All tasks must be stopped */
330
  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes);
331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353

  for (cap = free_capabilities; cap != NULL; cap = cap->link) {
    for (bd = cap->rNursery; bd; bd = bd->link) {
      bd->free = bd->start;
      ASSERT(bd->gen == g0);
      ASSERT(bd->step == g0s0);
      IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
    }
    cap->rCurrentNursery = cap->rNursery;
  }
#else
  for (bd = g0s0->blocks; bd; bd = bd->link) {
    bd->free = bd->start;
    ASSERT(bd->gen == g0);
    ASSERT(bd->step == g0s0);
    IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
  }
  MainRegTable.rNursery = g0s0->blocks;
  MainRegTable.rCurrentNursery = g0s0->blocks;
#endif
}

bdescr *
354
allocNursery (bdescr *last_bd, nat blocks)
355
{
356
  bdescr *bd;
357 358 359 360 361 362
  nat i;

  /* Allocate a nursery */
  for (i=0; i < blocks; i++) {
    bd = allocBlock();
    bd->link = last_bd;
363 364 365
    bd->step = g0s0;
    bd->gen = g0;
    bd->evacuated = 0;
366 367 368 369 370 371
    bd->free = bd->start;
    last_bd = bd;
  }
  return last_bd;
}

372
void
373 374 375 376
resizeNursery ( nat blocks )
{
  bdescr *bd;

377 378 379 380
#ifdef SMP
  barf("resizeNursery: can't resize in SMP mode");
#endif

381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407
  if (nursery_blocks == blocks) {
    ASSERT(g0s0->n_blocks == blocks);
    return;
  }

  else if (nursery_blocks < blocks) {
    IF_DEBUG(gc, fprintf(stderr, "Increasing size of nursery to %d blocks\n", 
			 blocks));
    g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
  } 

  else {
    bdescr *next_bd;
    
    IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n", 
			 blocks));
    for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
      next_bd = bd->link;
      freeGroup(bd);
      bd = next_bd;
    }
    g0s0->blocks = bd;
  }
  
  g0s0->n_blocks = nursery_blocks = blocks;
}

408 409 410 411 412 413 414 415 416 417 418 419 420 421
/* -----------------------------------------------------------------------------
   The allocate() interface

   allocate(n) always succeeds, and returns a chunk of memory n words
   long.  n can be larger than the size of a block if necessary, in
   which case a contiguous block group will be allocated.
   -------------------------------------------------------------------------- */

StgPtr
allocate(nat n)
{
  bdescr *bd;
  StgPtr p;

422 423
  ACQUIRE_LOCK(&sm_mutex);

424
  TICK_ALLOC_HEAP_NOCTR(n);
425 426 427
  CCS_ALLOC(CCCS,n);

  /* big allocation (>LARGE_OBJECT_THRESHOLD) */
428
  /* ToDo: allocate directly into generation 1 */
429 430 431
  if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
    nat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
    bd = allocGroup(req_blocks);
432 433 434 435 436
    dbl_link_onto(bd, &g0s0->large_objects);
    bd->gen  = g0;
    bd->step = g0s0;
    bd->evacuated = 0;
    bd->free = bd->start;
437 438 439 440 441
    /* don't add these blocks to alloc_blocks, since we're assuming
     * that large objects are likely to remain live for quite a while
     * (eg. running threads), so garbage collecting early won't make
     * much difference.
     */
442
    alloc_blocks += req_blocks;
443
    RELEASE_LOCK(&sm_mutex);
444 445 446 447 448 449 450 451 452 453
    return bd->start;

  /* small allocation (<LARGE_OBJECT_THRESHOLD) */
  } else if (small_alloc_list == NULL || alloc_Hp + n > alloc_HpLim) {
    if (small_alloc_list) {
      small_alloc_list->free = alloc_Hp;
    }
    bd = allocBlock();
    bd->link = small_alloc_list;
    small_alloc_list = bd;
454 455 456
    bd->gen = g0;
    bd->step = g0s0;
    bd->evacuated = 0;
457 458 459 460 461 462 463
    alloc_Hp = bd->start;
    alloc_HpLim = bd->start + BLOCK_SIZE_W;
    alloc_blocks++;
  }
  
  p = alloc_Hp;
  alloc_Hp += n;
464
  RELEASE_LOCK(&sm_mutex);
465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497
  return p;
}

lnat allocated_bytes(void)
{
  return (alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp));
}

/* -----------------------------------------------------------------------------
   Allocation functions for GMP.

   These all use the allocate() interface - we can't have any garbage
   collection going on during a gmp operation, so we use allocate()
   which always succeeds.  The gmp operations which might need to
   allocate will ask the storage manager (via doYouWantToGC()) whether
   a garbage collection is required, in case we get into a loop doing
   only allocate() style allocation.
   -------------------------------------------------------------------------- */

static void *
stgAllocForGMP (size_t size_in_bytes)
{
  StgArrWords* arr;
  nat data_size_in_words, total_size_in_words;
  
  /* should be a multiple of sizeof(StgWord) (whole no. of limbs) */
  ASSERT(size_in_bytes % sizeof(W_) == 0);
  
  data_size_in_words  = size_in_bytes / sizeof(W_);
  total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
  
  /* allocate and fill it in. */
  arr = (StgArrWords *)allocate(total_size_in_words);
498
  SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524
  
  /* and return a ptr to the goods inside the array */
  return(BYTE_ARR_CTS(arr));
}

static void *
stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
{
    void *new_stuff_ptr = stgAllocForGMP(new_size);
    nat i = 0;
    char *p = (char *) ptr;
    char *q = (char *) new_stuff_ptr;

    for (; i < old_size; i++, p++, q++) {
	*q = *p;
    }

    return(new_stuff_ptr);
}

static void
stgDeallocForGMP (void *ptr STG_UNUSED, 
		  size_t size STG_UNUSED)
{
    /* easy for us: the garbage collector does the dealloc'n */
}
525

526
/* -----------------------------------------------------------------------------
527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547
 * Stats and stuff
 * -------------------------------------------------------------------------- */

/* -----------------------------------------------------------------------------
 * calcAllocated()
 *
 * Approximate how much we've allocated: number of blocks in the
 * nursery + blocks allocated via allocate() - unused nusery blocks.
 * This leaves a little slop at the end of each block, and doesn't
 * take into account large objects (ToDo).
 * -------------------------------------------------------------------------- */

lnat
calcAllocated( void )
{
  nat allocated;
  bdescr *bd;

#ifdef SMP
  Capability *cap;

548 549 550 551
  /* All tasks must be stopped.  Can't assert that all the
     capabilities are owned by the scheduler, though: one or more
     tasks might have been stopped while they were running (non-main)
     threads. */
552
  /*  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes); */
553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581

  allocated = 
    n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
    + allocated_bytes();

  for (cap = free_capabilities; cap != NULL; cap = cap->link) {
    for ( bd = cap->rCurrentNursery->link; bd != NULL; bd = bd->link ) {
      allocated -= BLOCK_SIZE_W;
    }
    if (cap->rCurrentNursery->free < cap->rCurrentNursery->start 
	+ BLOCK_SIZE_W) {
      allocated -= (cap->rCurrentNursery->start + BLOCK_SIZE_W)
	- cap->rCurrentNursery->free;
    }
  }

#else /* !SMP */
  bdescr *current_nursery = MainRegTable.rCurrentNursery;

  allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
  for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
    allocated -= BLOCK_SIZE_W;
  }
  if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
    allocated -= (current_nursery->start + BLOCK_SIZE_W)
      - current_nursery->free;
  }
#endif

582
  total_allocated += allocated;
583 584
  return allocated;
}  
585 586 587 588 589 590 591 592 593

/* Approximate the amount of live data in the heap.  To be called just
 * after garbage collection (see GarbageCollect()).
 */
extern lnat 
calcLive(void)
{
  nat g, s;
  lnat live = 0;
594
  step *stp;
595 596

  if (RtsFlags.GcFlags.generations == 1) {
597
    live = (g0s0->to_blocks - 1) * BLOCK_SIZE_W + 
598
      ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_);
599
    return live;
600 601 602 603 604
  }

  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
    for (s = 0; s < generations[g].n_steps; s++) {
      /* approximate amount of live data (doesn't take into account slop
605 606
       * at end of each block).
       */
607 608 609
      if (g == 0 && s == 0) { 
	  continue; 
      }
610 611 612
      stp = &generations[g].steps[s];
      live += (stp->n_blocks - 1) * BLOCK_SIZE_W +
	((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start) / sizeof(W_);
613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629
    }
  }
  return live;
}

/* Approximate the number of blocks that will be needed at the next
 * garbage collection.
 *
 * Assume: all data currently live will remain live.  Steps that will
 * be collected next time will therefore need twice as many blocks
 * since all the data will be copied.
 */
extern lnat 
calcNeeded(void)
{
  lnat needed = 0;
  nat g, s;
630
  step *stp;
631 632 633 634

  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
    for (s = 0; s < generations[g].n_steps; s++) {
      if (g == 0 && s == 0) { continue; }
635
      stp = &generations[g].steps[s];
636
      if (generations[g].steps[0].n_blocks > generations[g].max_blocks) {
637
	needed += 2 * stp->n_blocks;
638
      } else {
639
	needed += stp->n_blocks;
640 641 642 643 644 645
      }
    }
  }
  return needed;
}

646 647 648 649 650 651 652 653 654 655 656 657 658 659
/* -----------------------------------------------------------------------------
   Debugging

   memInventory() checks for memory leaks by counting up all the
   blocks we know about and comparing that to the number of blocks
   allegedly floating around in the system.
   -------------------------------------------------------------------------- */

#ifdef DEBUG

extern void
memInventory(void)
{
  nat g, s;
660
  step *stp;
661 662 663 664
  bdescr *bd;
  lnat total_blocks = 0, free_blocks = 0;

  /* count the blocks we current have */
665

666 667
  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
    for (s = 0; s < generations[g].n_steps; s++) {
668 669
      stp = &generations[g].steps[s];
      total_blocks += stp->n_blocks;
670 671 672 673
      if (RtsFlags.GcFlags.generations == 1) {
	/* two-space collector has a to-space too :-) */
	total_blocks += g0s0->to_blocks;
      }
674
      for (bd = stp->large_objects; bd; bd = bd->link) {
675 676 677 678 679 680 681
	total_blocks += bd->blocks;
	/* hack for megablock groups: they have an extra block or two in
	   the second and subsequent megablocks where the block
	   descriptors would normally go.
	*/
	if (bd->blocks > BLOCKS_PER_MBLOCK) {
	  total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
682
	                  * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710
	}
      }
    }
  }

  /* any blocks held by allocate() */
  for (bd = small_alloc_list; bd; bd = bd->link) {
    total_blocks += bd->blocks;
  }
  for (bd = large_alloc_list; bd; bd = bd->link) {
    total_blocks += bd->blocks;
  }
  
  /* count the blocks on the free list */
  free_blocks = countFreeList();

  ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);

#if 0
  if (total_blocks + free_blocks != mblocks_allocated *
      BLOCKS_PER_MBLOCK) {
    fprintf(stderr, "Blocks: %ld live + %ld free  = %ld total (%ld around)\n",
	    total_blocks, free_blocks, total_blocks + free_blocks,
	    mblocks_allocated * BLOCKS_PER_MBLOCK);
  }
#endif
}

711 712 713 714 715 716
/* Full heap sanity check. */

extern void
checkSanity(nat N)
{
  nat g, s;
717 718

  if (RtsFlags.GcFlags.generations == 1) {
719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739
    checkHeap(g0s0->to_space, NULL);
    checkChain(g0s0->large_objects);
  } else {
    
    for (g = 0; g <= N; g++) {
      for (s = 0; s < generations[g].n_steps; s++) {
	if (g == 0 && s == 0) { continue; }
	checkHeap(generations[g].steps[s].blocks, NULL);
      }
    }
    for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
      for (s = 0; s < generations[g].n_steps; s++) {
	checkHeap(generations[g].steps[s].blocks,
		  generations[g].steps[s].blocks->start);
	checkChain(generations[g].steps[s].large_objects);
      }
    }
    checkFreeListSanity();
  }
}

740
#endif