ProfHeap.c 28 KB
Newer Older
1 2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The GHC Team, 1998-2003
4 5 6 7 8 9 10 11 12 13 14 15 16
 *
 * Support for heap profiling
 *
 * ---------------------------------------------------------------------------*/

#if defined(DEBUG) && !defined(PROFILING)
#define DEBUG_HEAP_PROF
#else
#undef DEBUG_HEAP_PROF
#endif

#if defined(PROFILING) || defined(DEBUG_HEAP_PROF)

17
#include "PosixSource.h"
18 19 20
#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
21
#include "Profiling.h"
22 23 24
#include "Storage.h"
#include "ProfHeap.h"
#include "Stats.h"
25 26
#include "Hash.h"
#include "StrHash.h"
27 28
#include "RetainerProfile.h"
#include "LdvProfile.h"
29
#include "Arena.h"
30 31
#include "Printer.h"

32
#include <string.h>
33
#include <stdlib.h>
34
#include <math.h>
35

36
/* -----------------------------------------------------------------------------
37 38
 * era stores the current time period.  It is the same as the
 * number of censuses that have been performed.
39
 *
40 41 42
 * RESTRICTION:
 *   era must be no longer than LDV_SHIFT (15 or 30) bits.
 * Invariants:
43
 *   era is initialized to 1 in initHeapProfiling().
44
 *
45 46 47
 * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling().
 * When era reaches max_era, the profiling stops because a closure can
 * store only up to (max_era - 1) as its creation or last use time.
48
 * -------------------------------------------------------------------------- */
49
unsigned int era;
50
static nat max_era;
51

52
/* -----------------------------------------------------------------------------
53 54 55 56 57 58 59
 * Counters
 *
 * For most heap profiles each closure identity gets a simple count
 * of live words in the heap at each census.  However, if we're
 * selecting by biography, then we have to keep the various
 * lag/drag/void counters for each identity.
 * -------------------------------------------------------------------------- */
60 61 62 63 64 65
typedef struct _counter {
    void *identity;
    union {
	nat resid;
	struct {
	    int prim;     // total size of 'inherently used' closures
66
	    int not_used; // total size of 'never used' closures
67
	    int used;     // total size of 'used at least once' closures
68 69
	    int void_total;  // current total size of 'destroyed without being used' closures
	    int drag_total;  // current total size of 'used at least once and waiting to die'
70 71 72 73
	} ldv;
    } c;
    struct _counter *next;
} counter;
74

sof's avatar
sof committed
75
STATIC_INLINE void
76 77 78 79 80 81 82 83 84
initLDVCtr( counter *ctr )
{
    ctr->c.ldv.prim = 0;
    ctr->c.ldv.not_used = 0;
    ctr->c.ldv.used = 0;
    ctr->c.ldv.void_total = 0;
    ctr->c.ldv.drag_total = 0;
}

85 86 87 88 89 90 91 92 93 94 95 96 97 98
typedef struct {
    double      time;    // the time in MUT time when the census is made
    HashTable * hash;
    counter   * ctrs;
    Arena     * arena;

    // for LDV profiling, when just displaying by LDV
    int       prim;
    int       not_used;
    int       used;
    int       void_total;
    int       drag_total;
} Census;

99 100
static Census *censuses = NULL;
static nat n_censuses = 0;
101

102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
#ifdef PROFILING
static void aggregateCensusInfo( void );
#endif

static void dumpCensus( Census *census );

/* -----------------------------------------------------------------------------
   Closure Type Profiling;

   PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
   -------------------------------------------------------------------------- */

#ifdef DEBUG_HEAP_PROF
static char *type_names[] = {
      "INVALID_OBJECT"
    , "CONSTR"
    , "CONSTR_INTLIKE"
    , "CONSTR_CHARLIKE"
    , "CONSTR_STATIC"
    , "CONSTR_NOCAF_STATIC"

    , "FUN"
    , "FUN_STATIC"

    , "THUNK"
    , "THUNK_STATIC"
    , "THUNK_SELECTOR"

    , "BCO"
131 132
    , "AP_STACK"
    , "AP"
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177

    , "PAP"

    , "IND"
    , "IND_OLDGEN"
    , "IND_PERM"
    , "IND_OLDGEN_PERM"
    , "IND_STATIC"

    , "RET_BCO"
    , "RET_SMALL"
    , "RET_VEC_SMALL"
    , "RET_BIG"
    , "RET_VEC_BIG"
    , "RET_DYN"
    , "UPDATE_FRAME"
    , "CATCH_FRAME"
    , "STOP_FRAME"

    , "BLACKHOLE"
    , "MVAR"

    , "ARR_WORDS"

    , "MUT_ARR_PTRS"
    , "MUT_ARR_PTRS_FROZEN"
    , "MUT_VAR"

    , "WEAK"
  
    , "TSO"

    , "BLOCKED_FETCH"
    , "FETCH_ME"

    , "EVACUATED"
};

#endif /* DEBUG_HEAP_PROF */

/* -----------------------------------------------------------------------------
 * Find the "closure identity", which is a unique pointer reresenting
 * the band to which this closure's heap space is attributed in the
 * heap profile.
 * ------------------------------------------------------------------------- */
sof's avatar
sof committed
178
STATIC_INLINE void *
179 180 181 182 183 184
closureIdentity( StgClosure *p )
{
    switch (RtsFlags.ProfFlags.doHeapProfile) {

#ifdef PROFILING
    case HEAP_BY_CCS:
185
	return p->header.prof.ccs;
186
    case HEAP_BY_MOD:
187
	return p->header.prof.ccs->cc->module;
188
    case HEAP_BY_DESCR:
189
	return get_itbl(p)->prof.closure_desc;
190
    case HEAP_BY_TYPE:
191
	return get_itbl(p)->prof.closure_type;
192
    case HEAP_BY_RETAINER:
193 194 195 196 197 198 199
	// AFAIK, the only closures in the heap which might not have a
	// valid retainer set are DEAD_WEAK closures.
	if (isRetainerSetFieldValid(p))
	    return retainerSetOf(p);
	else
	    return NULL;

200 201 202 203 204
#else // DEBUG
    case HEAP_BY_INFOPTR:
	return (void *)((StgClosure *)p)->header.info; 
    case HEAP_BY_CLOSURE_TYPE:
	return type_names[get_itbl(p)->type];
205

206 207 208 209 210 211
#endif
    default:
	barf("closureIdentity");
    }
}

212 213 214 215
/* --------------------------------------------------------------------------
 * Profiling type predicates
 * ----------------------------------------------------------------------- */
#ifdef PROFILING
sof's avatar
sof committed
216
STATIC_INLINE rtsBool
217
doingLDVProfiling( void )
218
{
219 220
    return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV 
	    || RtsFlags.ProfFlags.bioSelector != NULL);
221 222
}

sof's avatar
sof committed
223
STATIC_INLINE rtsBool
224
doingRetainerProfiling( void )
225
{
226 227 228
    return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
	    || RtsFlags.ProfFlags.retainerSelector != NULL);
}
229
#endif /* PROFILING */
230

231 232 233 234 235 236 237 238
// Precesses a closure 'c' being destroyed whose size is 'size'.
// Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
// such as TSO; they should not be involved in computing dragNew or voidNew.
// 
// Even though era is checked in both LdvCensusForDead() and 
// LdvCensusKillAll(), we still need to make sure that era is > 0 because 
// LDV_recordDead() may be called from elsewhere in the runtime system. E.g., 
// when a thunk is replaced by an indirection object.
239

240 241 242 243
#ifdef PROFILING
void
LDV_recordDead( StgClosure *c, nat size )
{
244 245 246 247
    void *id;
    nat t;
    counter *ctr;

248 249
    if (era > 0 && closureSatisfiesConstraints(c)) {
	size -= sizeofW(StgProfHeader);
250
	ASSERT(LDVW(c) != 0);
251 252 253
	if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
	    t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
	    if (t < era) {
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
		if (RtsFlags.ProfFlags.bioSelector == NULL) {
		    censuses[t].void_total   += (int)size;
		    censuses[era].void_total -= (int)size;
		} else {
		    id = closureIdentity(c);
		    ctr = lookupHashTable(censuses[t].hash, (StgWord)id);
		    ASSERT( ctr != NULL );
		    ctr->c.ldv.void_total += (int)size;
		    ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
		    if (ctr == NULL) {
			ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
			initLDVCtr(ctr);
			insertHashTable(censuses[era].hash, (StgWord)id, ctr);
			ctr->identity = id;
			ctr->next = censuses[era].ctrs;
			censuses[era].ctrs = ctr;
		    }
		    ctr->c.ldv.void_total -= (int)size;
		}
273 274
	    }
	} else {
275 276
	    t = LDVW((c)) & LDV_LAST_MASK;
	    if (t + 1 < era) {
277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
		if (RtsFlags.ProfFlags.bioSelector == NULL) {
		    censuses[t+1].drag_total += size;
		    censuses[era].drag_total -= size;
		} else {
		    void *id;
		    id = closureIdentity(c);
		    ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
		    ASSERT( ctr != NULL );
		    ctr->c.ldv.drag_total += (int)size;
		    ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
		    if (ctr == NULL) {
			ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
			initLDVCtr(ctr);
			insertHashTable(censuses[era].hash, (StgWord)id, ctr);
			ctr->identity = id;
			ctr->next = censuses[era].ctrs;
			censuses[era].ctrs = ctr;
		    }
		    ctr->c.ldv.drag_total -= (int)size;
		}
297
	    }
298 299 300
	}
    }
}
301
#endif
302

303 304 305
/* --------------------------------------------------------------------------
 * Initialize censuses[era];
 * ----------------------------------------------------------------------- */
sof's avatar
sof committed
306
STATIC_INLINE void
307
initEra(Census *census)
308
{
309 310 311 312 313 314 315 316 317
    census->hash  = allocHashTable();
    census->ctrs  = NULL;
    census->arena = newArena();

    census->not_used   = 0;
    census->used       = 0;
    census->prim       = 0;
    census->void_total = 0;
    census->drag_total = 0;
318 319
}

320 321 322 323
/* --------------------------------------------------------------------------
 * Increases era by 1 and initialize census[era].
 * Reallocates gi[] and increases its size if needed.
 * ----------------------------------------------------------------------- */
324
static void
325
nextEra( void )
326
{
327 328 329 330 331
#ifdef PROFILING
    if (doingLDVProfiling()) { 
	era++;

	if (era == max_era) {
332
	    errorBelch("maximum number of censuses reached; use +RTS -i to reduce");
333
	    stg_exit(EXIT_FAILURE);
334 335 336 337 338 339
	}
	
	if (era == n_censuses) {
	    n_censuses *= 2;
	    censuses = stgReallocBytes(censuses, sizeof(Census) * n_censuses,
				       "nextEra");
340 341
	}
    }
342
#endif /* PROFILING */
343

344
    initEra( &censuses[era] );
345 346
}

347 348 349
/* -----------------------------------------------------------------------------
 * DEBUG heap profiling, by info table
 * -------------------------------------------------------------------------- */
350

351
#ifdef DEBUG_HEAP_PROF
352
FILE *hp_file;
353
static char *hp_filename;
354

355 356 357 358 359
void initProfiling1( void )
{
}

void initProfiling2( void )
360
{
361 362 363 364 365 366 367
  if (RtsFlags.ProfFlags.doHeapProfile) {
    /* Initialise the log file name */
    hp_filename = stgMallocBytes(strlen(prog_name) + 6, "hpFileName");
    sprintf(hp_filename, "%s.hp", prog_name);
    
    /* open the log file */
    if ((hp_file = fopen(hp_filename, "w")) == NULL) {
368
      debugBelch("Can't open profiling report file %s\n", 
369 370 371 372 373 374
	      hp_filename);
      RtsFlags.ProfFlags.doHeapProfile = 0;
      return;
    }
  }
  
375 376 377 378 379 380 381 382 383
  initHeapProfiling();
}

void endProfiling( void )
{
  endHeapProfiling();
}
#endif /* DEBUG_HEAP_PROF */

384 385 386 387 388 389 390 391 392 393
static void
printSample(rtsBool beginSample, StgDouble sampleValue)
{
    StgDouble fractionalPart, integralPart;
    fractionalPart = modf(sampleValue, &integralPart);
    fprintf(hp_file, "%s %d.%02d\n",
            (beginSample ? "BEGIN_SAMPLE" : "END_SAMPLE"),
            (int)integralPart, (int)(fractionalPart * 100 + 0.5));
}

394 395 396
/* --------------------------------------------------------------------------
 * Initialize the heap profilier
 * ----------------------------------------------------------------------- */
397 398 399 400 401 402 403
nat
initHeapProfiling(void)
{
    if (! RtsFlags.ProfFlags.doHeapProfile) {
        return 0;
    }

404 405
#ifdef PROFILING
    if (doingLDVProfiling() && doingRetainerProfiling()) {
406
	errorBelch("cannot mix -hb and -hr");
407 408 409 410
	stg_exit(1);
    }
#endif

411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431
    // we only count eras if we're doing LDV profiling.  Otherwise era
    // is fixed at zero.
#ifdef PROFILING
    if (doingLDVProfiling()) {
	era = 1;
    } else
#endif
    {
	era = 0;
    }

    {   // max_era = 2^LDV_SHIFT
	nat p;
	max_era = 1;
	for (p = 0; p < LDV_SHIFT; p++)
	    max_era *= 2;
    }

    n_censuses = 32;
    censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");

432 433
    initEra( &censuses[era] );

434
    /* initProfilingLogFile(); */
sof's avatar
sof committed
435
    fprintf(hp_file, "JOB \"%s", prog_name);
436

437 438 439 440 441
#ifdef PROFILING
    {
	int count;
	for(count = 1; count < prog_argc; count++)
	    fprintf(hp_file, " %s", prog_argv[count]);
442
	fprintf(hp_file, " +RTS");
443
	for(count = 0; count < rts_argc; count++)
444
	    fprintf(hp_file, " %s", rts_argv[count]);
445
    }
446
#endif /* PROFILING */
447 448 449

    fprintf(hp_file, "\"\n" );

450
    fprintf(hp_file, "DATE \"%s\"\n", time_str());
451

452 453
    fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
    fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
454

455 456
    printSample(rtsTrue, 0);
    printSample(rtsFalse, 0);
457 458

#ifdef DEBUG_HEAP_PROF
sof's avatar
sof committed
459
    DEBUG_LoadSymbols(prog_name);
460 461
#endif

462
#ifdef PROFILING
463 464 465
    if (doingRetainerProfiling()) {
	initRetainerProfiling();
    }
466 467
#endif

468 469 470 471 472 473 474 475 476 477 478 479
    return 0;
}

void
endHeapProfiling(void)
{
    StgDouble seconds;

    if (! RtsFlags.ProfFlags.doHeapProfile) {
        return;
    }

480
#ifdef PROFILING
481
    if (doingRetainerProfiling()) {
482 483 484 485
	endRetainerProfiling();
    }
#endif

486
#ifdef PROFILING
487
    if (doingLDVProfiling()) {
488
	nat t;
489
	LdvCensusKillAll();
490 491 492
	aggregateCensusInfo();
	for (t = 1; t < era; t++) {
	    dumpCensus( &censuses[t] );
493 494
	}
    }
495
#endif
496

497
    seconds = mut_user_time();
498 499
    printSample(rtsTrue, seconds);
    printSample(rtsFalse, seconds);
500
    fclose(hp_file);
501 502 503 504 505
}



#ifdef PROFILING
506 507 508 509 510 511 512 513 514 515 516 517
static size_t
buf_append(char *p, const char *q, char *end)
{
    int m;

    for (m = 0; p < end; p++, q++, m++) {
	*p = *q;
	if (*q == '\0') { break; }
    }
    return m;
}

518
static void
519
fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
520
{
521
    char buf[max_length+1], *p, *buf_end;
522 523 524 525 526 527 528 529
    nat next_offset = 0;
    nat written;

    // MAIN on its own gets printed as "MAIN", otherwise we ignore MAIN.
    if (ccs == CCS_MAIN) {
	fprintf(fp, "MAIN");
	return;
    }
530

531
    fprintf(fp, "(%ld)", ccs->ccsID);
532

533 534 535
    p = buf;
    buf_end = buf + max_length + 1;

536 537 538
    // keep printing components of the stack until we run out of space
    // in the buffer.  If we run out of space, end with "...".
    for (; ccs != NULL && ccs != CCS_MAIN; ccs = ccs->prevStack) {
539

540 541 542
	// CAF cost centres print as M.CAF, but we leave the module
	// name out of all the others to save space.
	if (!strcmp(ccs->cc->label,"CAF")) {
543 544
	    p += buf_append(p, ccs->cc->module, buf_end);
	    p += buf_append(p, ".CAF", buf_end);
545 546
	} else {
	    if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
547
		p += buf_append(p, "/", buf_end);
548
	    }
549
	    p += buf_append(p, ccs->cc->label, buf_end);
550
	}
551 552
	
	if (p >= buf_end) {
553 554 555 556 557 558 559
	    sprintf(buf+max_length-4, "...");
	    break;
	} else {
	    next_offset += written;
	}
    }
    fprintf(fp, "%s", buf);
560
}
561
#endif /* PROFILING */
562

563 564
rtsBool
strMatchesSelector( char* str, char* sel )
565 566
{
   char* p;
567
   // debugBelch("str_matches_selector %s %s\n", str, sel);
568
   while (1) {
569 570 571 572 573 574 575 576 577 578 579 580 581 582 583
       // Compare str against wherever we've got to in sel.
       p = str;
       while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
	   p++; sel++;
       }
       // Match if all of str used and have reached the end of a sel fragment.
       if (*p == '\0' && (*sel == ',' || *sel == '\0'))
	   return rtsTrue;
       
       // No match.  Advance sel to the start of the next elem.
       while (*sel != ',' && *sel != '\0') sel++;
       if (*sel == ',') sel++;
       
       /* Run out of sel ?? */
       if (*sel == '\0') return rtsFalse;
584 585 586
   }
}

587 588 589 590
/* -----------------------------------------------------------------------------
 * Figure out whether a closure should be counted in this census, by
 * testing against all the specified constraints.
 * -------------------------------------------------------------------------- */
591 592
rtsBool
closureSatisfiesConstraints( StgClosure* p )
593
{
594
#ifdef DEBUG_HEAP_PROF
595
    (void)p;   /* keep gcc -Wall happy */
596 597
    return rtsTrue;
#else
598
   rtsBool b;
599 600 601 602 603 604

   // The CCS has a selected field to indicate whether this closure is
   // deselected by not being mentioned in the module, CC, or CCS
   // selectors.
   if (!p->header.prof.ccs->selected) {
       return rtsFalse;
605
   }
606

607
   if (RtsFlags.ProfFlags.descrSelector) {
608
       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
609 610
				 RtsFlags.ProfFlags.descrSelector );
       if (!b) return rtsFalse;
611 612
   }
   if (RtsFlags.ProfFlags.typeSelector) {
613
       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
614
                                RtsFlags.ProfFlags.typeSelector );
615
       if (!b) return rtsFalse;
616
   }
617 618 619
   if (RtsFlags.ProfFlags.retainerSelector) {
       RetainerSet *rs;
       nat i;
620 621 622 623 624 625 626 627 628 629 630 631
       // We must check that the retainer set is valid here.  One
       // reason it might not be valid is if this closure is a
       // a newly deceased weak pointer (i.e. a DEAD_WEAK), since
       // these aren't reached by the retainer profiler's traversal.
       if (isRetainerSetFieldValid((StgClosure *)p)) {
	   rs = retainerSetOf((StgClosure *)p);
	   if (rs != NULL) {
	       for (i = 0; i < rs->num; i++) {
		   b = strMatchesSelector( rs->element[i]->cc->label,
					   RtsFlags.ProfFlags.retainerSelector );
		   if (b) return rtsTrue;
	       }
632 633 634 635
	   }
       }
       return rtsFalse;
   }
636 637
   return rtsTrue;
#endif /* PROFILING */
638
}
639

640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665
/* -----------------------------------------------------------------------------
 * Aggregate the heap census info for biographical profiling
 * -------------------------------------------------------------------------- */
#ifdef PROFILING
static void
aggregateCensusInfo( void )
{
    HashTable *acc;
    nat t;
    counter *c, *d, *ctrs;
    Arena *arena;

    if (!doingLDVProfiling()) return;

    // Aggregate the LDV counters when displaying by biography.
    if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
	int void_total, drag_total;

	// Now we compute void_total and drag_total for each census
	void_total = 0;
	drag_total = 0;
	for (t = 1; t < era; t++) { // note: start at 1, not 0
	    void_total += censuses[t].void_total;
	    drag_total += censuses[t].drag_total;
	    censuses[t].void_total = void_total;
	    censuses[t].drag_total = drag_total;
666 667
	    ASSERT( censuses[t].void_total <= censuses[t].not_used );
	    ASSERT( censuses[t].drag_total <= censuses[t].used );
668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695
	}
	
	return;
    }

    // otherwise... we're doing a heap profile that is restricted to
    // some combination of lag, drag, void or use.  We've kept all the
    // census info for all censuses so far, but we still need to
    // aggregate the counters forwards.

    arena = newArena();
    acc = allocHashTable();
    ctrs = NULL;

    for (t = 1; t < era; t++) {

	// first look through all the counters we're aggregating
	for (c = ctrs; c != NULL; c = c->next) {
	    // if one of the totals is non-zero, then this closure
	    // type must be present in the heap at this census time...
	    d = lookupHashTable(censuses[t].hash, (StgWord)c->identity);

	    if (d == NULL) {
		// if this closure identity isn't present in the
		// census for this time period, then our running
		// totals *must* be zero.
		ASSERT(c->c.ldv.void_total == 0 && c->c.ldv.drag_total == 0);

696 697
		// debugCCS(c->identity);
		// debugBelch(" census=%d void_total=%d drag_total=%d\n",
698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732
		//         t, c->c.ldv.void_total, c->c.ldv.drag_total);
	    } else {
		d->c.ldv.void_total += c->c.ldv.void_total;
		d->c.ldv.drag_total += c->c.ldv.drag_total;
		c->c.ldv.void_total =  d->c.ldv.void_total;
		c->c.ldv.drag_total =  d->c.ldv.drag_total;

		ASSERT( c->c.ldv.void_total >= 0 );
		ASSERT( c->c.ldv.drag_total >= 0 );
	    }
	}

	// now look through the counters in this census to find new ones
	for (c = censuses[t].ctrs; c != NULL; c = c->next) {
	    d = lookupHashTable(acc, (StgWord)c->identity);
	    if (d == NULL) {
		d = arenaAlloc( arena, sizeof(counter) );
		initLDVCtr(d);
		insertHashTable( acc, (StgWord)c->identity, d );
		d->identity = c->identity;
		d->next = ctrs;
		ctrs = d;
		d->c.ldv.void_total = c->c.ldv.void_total;
		d->c.ldv.drag_total = c->c.ldv.drag_total;
	    }
	    ASSERT( c->c.ldv.void_total >= 0 );
	    ASSERT( c->c.ldv.drag_total >= 0 );
	}
    }

    freeHashTable(acc, NULL);
    arenaFree(arena);
}
#endif

733 734 735 736 737 738 739
/* -----------------------------------------------------------------------------
 * Print out the results of a heap census.
 * -------------------------------------------------------------------------- */
static void
dumpCensus( Census *census )
{
    counter *ctr;
740 741
    int count;

742
    printSample(rtsTrue, census->time);
743

744 745
#ifdef PROFILING
    if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
746
      fprintf(hp_file, "VOID\t%lu\n", (unsigned long)(census->void_total) * sizeof(W_));
747
	fprintf(hp_file, "LAG\t%lu\n", 
748
		(unsigned long)(census->not_used - census->void_total) * sizeof(W_));
749
	fprintf(hp_file, "USE\t%lu\n", 
750
		(unsigned long)(census->used - census->drag_total) * sizeof(W_));
751
	fprintf(hp_file, "INHERENT_USE\t%lu\n", 
752 753 754
		(unsigned long)(census->prim) * sizeof(W_));
	fprintf(hp_file, "DRAG\t%lu\n",
		(unsigned long)(census->drag_total) * sizeof(W_));
755
	printSample(rtsFalse, census->time);
756 757 758 759
	return;
    }
#endif

760
    for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
761 762

#ifdef PROFILING
763 764
	if (RtsFlags.ProfFlags.bioSelector != NULL) {
	    count = 0;
765
	    if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector))
766
		count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
767
	    if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector))
768
		count += ctr->c.ldv.drag_total;
769
	    if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector))
770
		count += ctr->c.ldv.void_total;
771
	    if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector))
772 773
		count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
	} else
774
#endif
775 776 777
	{
	    count = ctr->c.resid;
	}
778

779
	ASSERT( count >= 0 );
780

781
	if (count == 0) continue;
782 783 784 785

#ifdef DEBUG_HEAP_PROF
	switch (RtsFlags.ProfFlags.doHeapProfile) {
	case HEAP_BY_INFOPTR:
786
	    fprintf(hp_file, "%s", lookupGHCName(ctr->identity));
787 788
	    break;
	case HEAP_BY_CLOSURE_TYPE:
789
	    fprintf(hp_file, "%s", (char *)ctr->identity);
790 791 792 793 794 795 796
	    break;
	}
#endif
	
#ifdef PROFILING
	switch (RtsFlags.ProfFlags.doHeapProfile) {
	case HEAP_BY_CCS:
797
	    fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, 25);
798 799 800 801 802 803 804 805 806 807
	    break;
	case HEAP_BY_MOD:
	case HEAP_BY_DESCR:
	case HEAP_BY_TYPE:
	    fprintf(hp_file, "%s", (char *)ctr->identity);
	    break;
	case HEAP_BY_RETAINER:
	{
	    RetainerSet *rs = (RetainerSet *)ctr->identity;

808 809 810 811 812 813
	    // it might be the distinguished retainer set rs_MANY:
	    if (rs == &rs_MANY) {
		fprintf(hp_file, "MANY");
		break;
	    }

814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831
	    // Mark this retainer set by negating its id, because it
	    // has appeared in at least one census.  We print the
	    // values of all such retainer sets into the log file at
	    // the end.  A retainer set may exist but not feature in
	    // any censuses if it arose as the intermediate retainer
	    // set for some closure during retainer set calculation.
	    if (rs->id > 0)
		rs->id = -(rs->id);

	    // report in the unit of bytes: * sizeof(StgWord)
	    printRetainerSetShort(hp_file, rs);
	    break;
	}
	default:
	    barf("dumpCensus; doHeapProfile");
	}
#endif

832
	fprintf(hp_file, "\t%lu\n", (unsigned long)count * sizeof(W_));
833 834
    }

835
    printSample(rtsFalse, census->time);
836 837
}

838 839 840 841
/* -----------------------------------------------------------------------------
 * Code to perform a heap census.
 * -------------------------------------------------------------------------- */
static void
842
heapCensusChain( Census *census, bdescr *bd )
843 844 845
{
    StgPtr p;
    StgInfoTable *info;
846
    void *identity;
847
    nat size;
848
    counter *ctr;
849
    nat real_size;
850
    rtsBool prim;
851

852
    for (; bd != NULL; bd = bd->link) {
853 854 855 856 857 858 859 860 861

	// HACK: ignore pinned blocks, because they contain gaps.
	// It's not clear exactly what we'd like to do here, since we
	// can't tell which objects in the block are actually alive.
	// Perhaps the whole block should be counted as SYSTEM memory.
	if (bd->flags & BF_PINNED) {
	    continue;
	}

862 863 864
	p = bd->start;
	while (p < bd->free) {
	    info = get_itbl((StgClosure *)p);
865
	    prim = rtsFalse;
866 867 868
	    
	    switch (info->type) {

869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884
	    case THUNK:
		size = thunk_sizeW_fromITBL(info);
		break;

	    case THUNK_1_1:
	    case THUNK_0_2:
	    case THUNK_2_0:
		size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE,2);
		break;

	    case THUNK_1_0:
	    case THUNK_0_1:
	    case THUNK_SELECTOR:
		size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE,1);
		break;

885 886 887
	    case CONSTR:
	    case FUN:
	    case IND_PERM:
888
	    case IND_OLDGEN:
889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908
	    case IND_OLDGEN_PERM:
	    case CAF_BLACKHOLE:
	    case SE_CAF_BLACKHOLE:
	    case SE_BLACKHOLE:
	    case BLACKHOLE:
	    case CONSTR_INTLIKE:
	    case CONSTR_CHARLIKE:
	    case FUN_1_0:
	    case FUN_0_1:
	    case FUN_1_1:
	    case FUN_0_2:
	    case FUN_2_0:
	    case CONSTR_1_0:
	    case CONSTR_0_1:
	    case CONSTR_1_1:
	    case CONSTR_0_2:
	    case CONSTR_2_0:
		size = sizeW_fromITBL(info);
		break;
		
909
	    case BCO:
910 911 912 913
		prim = rtsTrue;
		size = bco_sizeW((StgBCO *)p);
		break;

914 915 916 917 918 919 920 921
	    case MVAR:
	    case WEAK:
	    case STABLE_NAME:
	    case MUT_VAR:
		prim = rtsTrue;
		size = sizeW_fromITBL(info);
		break;

922 923
	    case AP:
		size = ap_sizeW((StgAP *)p);
924 925 926 927 928
		break;

	    case PAP:
		size = pap_sizeW((StgPAP *)p);
		break;
929 930 931 932

	    case AP_STACK:
		size = ap_stack_sizeW((StgAP_STACK *)p);
		break;
933 934
		
	    case ARR_WORDS:
935
		prim = rtsTrue;
936 937 938 939 940
		size = arr_words_sizeW(stgCast(StgArrWords*,p));
		break;
		
	    case MUT_ARR_PTRS:
	    case MUT_ARR_PTRS_FROZEN:
941
		prim = rtsTrue;
942 943 944 945
		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
		break;
		
	    case TSO:
946
		prim = rtsTrue;
947 948 949 950
#ifdef DEBUG_HEAP_PROF
		size = tso_sizeW((StgTSO *)p);
		break;
#else
951 952 953 954 955 956 957 958
		if (RtsFlags.ProfFlags.includeTSOs) {
		    size = tso_sizeW((StgTSO *)p);
		    break;
		} else {
		    // Skip this TSO and move on to the next object
		    p += tso_sizeW((StgTSO *)p);
		    continue;
		}
959 960
#endif

961 962 963 964
	    default:
		barf("heapCensus");
	    }
	    
965 966
	    identity = NULL;

967
#ifdef DEBUG_HEAP_PROF
968
	    real_size = size;
969
#else
970 971
	    // subtract the profiling overhead
	    real_size = size - sizeofW(StgProfHeader);
972
#endif
973 974

	    if (closureSatisfiesConstraints((StgClosure*)p)) {
975 976
#ifdef PROFILING
		if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
977 978 979 980 981 982
		    if (prim)
			census->prim += real_size;
		    else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
			census->not_used += real_size;
		    else
			census->used += real_size;
983
		} else
984
#endif
985 986
		{
		    identity = closureIdentity((StgClosure *)p);
987

988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026
		    if (identity != NULL) {
			ctr = lookupHashTable( census->hash, (StgWord)identity );
			if (ctr != NULL) {
#ifdef PROFILING
			    if (RtsFlags.ProfFlags.bioSelector != NULL) {
				if (prim)
				    ctr->c.ldv.prim += real_size;
				else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
				    ctr->c.ldv.not_used += real_size;
				else
				    ctr->c.ldv.used += real_size;
			    } else
#endif
			    {
				ctr->c.resid += real_size;
			    }
			} else {
			    ctr = arenaAlloc( census->arena, sizeof(counter) );
			    initLDVCtr(ctr);
			    insertHashTable( census->hash, (StgWord)identity, ctr );
			    ctr->identity = identity;
			    ctr->next = census->ctrs;
			    census->ctrs = ctr;

#ifdef PROFILING
			    if (RtsFlags.ProfFlags.bioSelector != NULL) {
				if (prim)
				    ctr->c.ldv.prim = real_size;
				else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
				    ctr->c.ldv.not_used = real_size;
				else
				    ctr->c.ldv.used = real_size;
			    } else
#endif
			    {
				ctr->c.resid = real_size;
			    }
			}
		    }
1027 1028 1029
		}
	    }

1030 1031 1032 1033
	    p += size;
	}
    }
}
andy's avatar
andy committed
1034

1035
void
1036
heapCensus( void )
1037
{
1038
  nat g, s;
1039 1040 1041 1042 1043 1044
  Census *census;

  census = &censuses[era];
  census->time  = mut_user_time();
    
  // calculate retainer sets if necessary
1045
#ifdef PROFILING
1046 1047
  if (doingRetainerProfiling()) {
      retainerProfile();
1048 1049 1050
  }
#endif

1051
#ifdef PROFILING
1052
  stat_startHeapCensus();
1053
#endif
1054

1055 1056 1057 1058 1059
  // Traverse the heap, collecting the census info

  // First the small_alloc_list: we have to fix the free pointer at
  // the end by calling tidyAllocatedLists() first.
  tidyAllocateLists();
1060
  heapCensusChain( census, small_alloc_list );
1061 1062

  // Now traverse the heap in each generation/step.
1063
  if (RtsFlags.GcFlags.generations == 1) {
1064
      heapCensusChain( census, g0s0->blocks );
1065 1066 1067
  } else {
      for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
	  for (s = 0; s < generations[g].n_steps; s++) {
1068 1069 1070
	      heapCensusChain( census, generations[g].steps[s].blocks );
	      // Are we interested in large objects?  might be
	      // confusing to include the stack in a heap profile.
1071
	      heapCensusChain( census, generations[g].steps[s].large_objects );
1072
	  }
1073
      }
1074 1075
  }

1076
  // dump out the census info
1077