ProfHeap.c 27 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
 * $Id: ProfHeap.c,v 1.43 2003/02/20 15:39:59 simonmar Exp $
3
 *
4
 * (c) The GHC Team, 1998-2000
5
6
7
8
9
10
11
12
13
14
15
16
17
 *
 * 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)

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

33
#include <string.h>
34
#include <stdlib.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
50
nat era;
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

75
76
77
78
79
80
81
82
83
84
static inline void
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
178
179
180
181
182
183
184
185
186

    , "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"
    , "BLACKHOLE_BQ"
    , "MVAR"

    , "ARR_WORDS"

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

    , "WEAK"
    , "FOREIGN"
  
    , "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.
 * ------------------------------------------------------------------------- */
static inline void *
closureIdentity( StgClosure *p )
{
    switch (RtsFlags.ProfFlags.doHeapProfile) {

#ifdef PROFILING
    case HEAP_BY_CCS:
187
	return p->header.prof.ccs;
188
    case HEAP_BY_MOD:
189
	return p->header.prof.ccs->cc->module;
190
    case HEAP_BY_DESCR:
191
	return get_itbl(p)->prof.closure_desc;
192
    case HEAP_BY_TYPE:
193
	return get_itbl(p)->prof.closure_type;
194
    case HEAP_BY_RETAINER:
195
196
197
198
199
200
201
	// 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;

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

208
209
210
211
212
213
#endif
    default:
	barf("closureIdentity");
    }
}

214
215
216
217
218
219
/* --------------------------------------------------------------------------
 * Profiling type predicates
 * ----------------------------------------------------------------------- */
#ifdef PROFILING
static inline rtsBool
doingLDVProfiling( void )
220
{
221
222
    return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV 
	    || RtsFlags.ProfFlags.bioSelector != NULL);
223
224
}

225
226
static inline rtsBool
doingRetainerProfiling( void )
227
{
228
229
230
231
    return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
	    || RtsFlags.ProfFlags.retainerSelector != NULL);
}
#endif // PROFILING
232

233
234
235
236
237
238
239
240
// 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.
241

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

250
251
252
253
254
    if (era > 0 && closureSatisfiesConstraints(c)) {
	size -= sizeofW(StgProfHeader);
	if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
	    t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
	    if (t < era) {
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
		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;
		}
274
275
	    }
	} else {
276
277
	    t = LDVW((c)) & LDV_LAST_MASK;
	    if (t + 1 < era) {
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
		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;
		}
298
	    }
299
300
301
	}
    }
}
302
#endif
303

304
305
306
307
/* --------------------------------------------------------------------------
 * Initialize censuses[era];
 * ----------------------------------------------------------------------- */
static inline void
308
initEra(Census *census)
309
{
310
311
312
313
314
315
316
317
318
    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;
319
320
}

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

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

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

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

352
#ifdef DEBUG_HEAP_PROF
353
FILE *hp_file;
354

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

void initProfiling2( void )
360
361
362
363
364
365
366
367
368
369
{
  initHeapProfiling();
}

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

370
371
372
/* --------------------------------------------------------------------------
 * Initialize the heap profilier
 * ----------------------------------------------------------------------- */
373
374
375
376
377
378
379
nat
initHeapProfiling(void)
{
    if (! RtsFlags.ProfFlags.doHeapProfile) {
        return 0;
    }

380
381
382
383
384
385
386
#ifdef PROFILING
    if (doingLDVProfiling() && doingRetainerProfiling()) {
	prog_belch("cannot mix -hb and -hr");
	stg_exit(1);
    }
#endif

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
    // 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");

408
409
    initEra( &censuses[era] );

410
411
    fprintf(hp_file, "JOB \"%s", prog_argv[0]);

412
413
414
415
416
417
418
419
420
#ifdef PROFILING
    {
	int count;
	for(count = 1; count < prog_argc; count++)
	    fprintf(hp_file, " %s", prog_argv[count]);
	fprintf(hp_file, " +RTS ");
	for(count = 0; count < rts_argc; count++)
	    fprintf(hp_file, "%s ", rts_argv[count]);
	fprintf(hp_file, "\n");
421
    }
422
#endif /* PROFILING */
423
424
425

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

426
    fprintf(hp_file, "DATE \"%s\"\n", time_str());
427

428
429
    fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
    fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
430

431
432
    fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
    fprintf(hp_file, "END_SAMPLE 0.00\n");
433
434
435
436
437

#ifdef DEBUG_HEAP_PROF
    DEBUG_LoadSymbols(prog_argv[0]);
#endif

438
#ifdef PROFILING
439
440
441
    if (doingRetainerProfiling()) {
	initRetainerProfiling();
    }
442
443
#endif

444
445
446
447
448
449
450
451
452
453
454
455
    return 0;
}

void
endHeapProfiling(void)
{
    StgDouble seconds;

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

456
#ifdef PROFILING
457
    if (doingRetainerProfiling()) {
458
459
460
461
	endRetainerProfiling();
    }
#endif

462
#ifdef PROFILING
463
    if (doingLDVProfiling()) {
464
	nat t;
465
	LdvCensusKillAll();
466
467
468
	aggregateCensusInfo();
	for (t = 1; t < era; t++) {
	    dumpCensus( &censuses[t] );
469
470
	}
    }
471
#endif
472

473
474
475
476
    seconds = mut_user_time();
    fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
    fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
    fclose(hp_file);
477
478
479
480
481
482
}



#ifdef PROFILING
static void
483
fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
484
{
485
486
487
488
489
490
491
492
493
494
    char buf[max_length+1];
    nat next_offset = 0;
    nat written;
    char *template;

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

496
497
    fprintf(fp, "(%d)", ccs->ccsID);

498
499
500
    // 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) {
501

502
503
504
	// 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")) {
sof's avatar
sof committed
505
#ifdef HAVE_SNPRINTF
506
507
508
	    written = snprintf(buf+next_offset, 
			       (int)max_length-3-(int)next_offset,
			       "%s.CAF", ccs->cc->module);
sof's avatar
sof committed
509
510
511
512
#else
	    written = sprintf(buf+next_offset, 
			       "%s.CAF", ccs->cc->module);
#endif
513
514
515
516
517
518
	} else {
	    if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
		template = "%s/";
	    } else {
		template = "%s";
	    }
sof's avatar
sof committed
519
#ifdef HAVE_SNPRINTF
520
521
522
	    written = snprintf(buf+next_offset, 
			       (int)max_length-3-(int)next_offset,
			       template, ccs->cc->label);
sof's avatar
sof committed
523
524
525
526
#else
	    written = sprintf(buf+next_offset, 
			       template, ccs->cc->label);
#endif
527
	}
528

529
530
531
532
533
534
535
536
	if (next_offset+written >= max_length-4) {
	    sprintf(buf+max_length-4, "...");
	    break;
	} else {
	    next_offset += written;
	}
    }
    fprintf(fp, "%s", buf);
537
}
538
#endif // PROFILING
539

540
541
rtsBool
strMatchesSelector( char* str, char* sel )
542
543
{
   char* p;
544
   // fprintf(stderr, "str_matches_selector %s %s\n", str, sel);
545
   while (1) {
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
       // 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;
561
562
563
   }
}

564
565
566
567
/* -----------------------------------------------------------------------------
 * Figure out whether a closure should be counted in this census, by
 * testing against all the specified constraints.
 * -------------------------------------------------------------------------- */
568
569
rtsBool
closureSatisfiesConstraints( StgClosure* p )
570
{
571
572
573
#ifdef DEBUG_HEAP_PROF
    return rtsTrue;
#else
574
   rtsBool b;
575
576
577
578
579
580

   // 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;
581
   }
582

583
   if (RtsFlags.ProfFlags.descrSelector) {
584
       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
585
586
				 RtsFlags.ProfFlags.descrSelector );
       if (!b) return rtsFalse;
587
588
   }
   if (RtsFlags.ProfFlags.typeSelector) {
589
       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
590
                                RtsFlags.ProfFlags.typeSelector );
591
       if (!b) return rtsFalse;
592
   }
593
594
595
   if (RtsFlags.ProfFlags.retainerSelector) {
       RetainerSet *rs;
       nat i;
596
597
598
599
600
601
602
603
604
605
606
607
       // 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;
	       }
608
609
610
611
	   }
       }
       return rtsFalse;
   }
612
613
   return rtsTrue;
#endif /* PROFILING */
614
}
615

616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
/* -----------------------------------------------------------------------------
 * 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;
642
643
	    ASSERT( censuses[t].void_total <= censuses[t].not_used );
	    ASSERT( censuses[t].drag_total <= censuses[t].used );
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
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
696
697
698
699
700
701
702
703
704
705
706
707
708
	}
	
	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);

		// fprintCCS(stderr,c->identity);
		// fprintf(stderr," census=%d void_total=%d drag_total=%d\n",
		//         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

709
710
711
712
713
714
715
/* -----------------------------------------------------------------------------
 * Print out the results of a heap census.
 * -------------------------------------------------------------------------- */
static void
dumpCensus( Census *census )
{
    counter *ctr;
716
717
718
719
    int count;

    fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", census->time);

720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
#ifdef PROFILING
    if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
	fprintf(hp_file, "VOID\t%u\n", census->void_total * sizeof(W_));
	fprintf(hp_file, "LAG\t%u\n", 
		(census->not_used - census->void_total) * sizeof(W_));
	fprintf(hp_file, "USE\t%u\n", 
		(census->used - census->drag_total) * sizeof(W_));
	fprintf(hp_file, "INHERENT_USE\t%u\n", 
		census->prim * sizeof(W_));
	fprintf(hp_file, "DRAG\t%u\n", census->drag_total *
		sizeof(W_));
	fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
	return;
    }
#endif

736
    for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
737
738

#ifdef PROFILING
739
740
	if (RtsFlags.ProfFlags.bioSelector != NULL) {
	    count = 0;
741
	    if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector))
742
		count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
743
	    if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector))
744
		count += ctr->c.ldv.drag_total;
745
	    if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector))
746
		count += ctr->c.ldv.void_total;
747
	    if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector))
748
749
		count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
	} else
750
#endif
751
752
753
	{
	    count = ctr->c.resid;
	}
754

755
	ASSERT( count >= 0 );
756

757
	if (count == 0) continue;
758
759
760
761

#ifdef DEBUG_HEAP_PROF
	switch (RtsFlags.ProfFlags.doHeapProfile) {
	case HEAP_BY_INFOPTR:
762
	    fprintf(hp_file, "%s", lookupGHCName(ctr->identity));
763
764
	    break;
	case HEAP_BY_CLOSURE_TYPE:
765
	    fprintf(hp_file, "%s", (char *)ctr->identity);
766
767
768
769
770
771
772
	    break;
	}
#endif
	
#ifdef PROFILING
	switch (RtsFlags.ProfFlags.doHeapProfile) {
	case HEAP_BY_CCS:
773
	    fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, 25);
774
775
776
777
778
779
780
781
782
783
	    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;

784
785
786
787
788
789
	    // it might be the distinguished retainer set rs_MANY:
	    if (rs == &rs_MANY) {
		fprintf(hp_file, "MANY");
		break;
	    }

790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
	    // 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

808
	fprintf(hp_file, "\t%d\n", count * sizeof(W_));
809
810
811
812
813
    }

    fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
}

814
815
816
817
/* -----------------------------------------------------------------------------
 * Code to perform a heap census.
 * -------------------------------------------------------------------------- */
static void
818
heapCensusChain( Census *census, bdescr *bd )
819
820
821
{
    StgPtr p;
    StgInfoTable *info;
822
    void *identity;
823
    nat size;
824
    counter *ctr;
825
    nat real_size;
826
    rtsBool prim;
827

828
829
830
831
    for (; bd != NULL; bd = bd->link) {
	p = bd->start;
	while (p < bd->free) {
	    info = get_itbl((StgClosure *)p);
832
	    prim = rtsFalse;
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
	    
	    switch (info->type) {

	    case CONSTR:
	    case FUN:
	    case THUNK:
	    case IND_PERM:
	    case IND_OLDGEN_PERM:
	    case CAF_BLACKHOLE:
	    case SE_CAF_BLACKHOLE:
	    case SE_BLACKHOLE:
	    case BLACKHOLE:
	    case BLACKHOLE_BQ:
	    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 THUNK_1_1:
	    case THUNK_0_2:
	    case THUNK_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;
		
864
865
866
867
868
869
870
871
872
873
874
	    case BCO:
	    case MVAR:
	    case WEAK:
	    case FOREIGN:
	    case STABLE_NAME:
	    case MUT_VAR:
	    case MUT_CONS:
		prim = rtsTrue;
		size = sizeW_fromITBL(info);
		break;

875
876
877
878
879
880
	    case THUNK_1_0:		/* ToDo - shouldn't be here */
	    case THUNK_0_1:		/* "  ditto  " */
	    case THUNK_SELECTOR:
		size = sizeofW(StgHeader) + MIN_UPD_SIZE;
		break;

881
	    case AP:
882
883
884
	    case PAP:
		size = pap_sizeW((StgPAP *)p);
		break;
885
886
887
888

	    case AP_STACK:
		size = ap_stack_sizeW((StgAP_STACK *)p);
		break;
889
890
		
	    case ARR_WORDS:
891
		prim = rtsTrue;
892
893
894
895
896
		size = arr_words_sizeW(stgCast(StgArrWords*,p));
		break;
		
	    case MUT_ARR_PTRS:
	    case MUT_ARR_PTRS_FROZEN:
897
		prim = rtsTrue;
898
899
900
901
		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
		break;
		
	    case TSO:
902
		prim = rtsTrue;
903
904
905
906
#ifdef DEBUG_HEAP_PROF
		size = tso_sizeW((StgTSO *)p);
		break;
#else
907
908
909
910
911
912
913
914
		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;
		}
915
916
#endif

917
918
919
920
	    default:
		barf("heapCensus");
	    }
	    
921
922
	    identity = NULL;

923
#ifdef DEBUG_HEAP_PROF
924
	    real_size = size;
925
#else
926
927
	    // subtract the profiling overhead
	    real_size = size - sizeofW(StgProfHeader);
928
#endif
929
930

	    if (closureSatisfiesConstraints((StgClosure*)p)) {
931
932
#ifdef PROFILING
		if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
933
934
935
936
937
938
		    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;
939
		} else
940
#endif
941
942
		{
		    identity = closureIdentity((StgClosure *)p);
943

944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
		    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;
			    }
			}
		    }
983
984
985
		}
	    }

986
987
988
989
	    p += size;
	}
    }
}
andy's avatar
andy committed
990

991
void
992
heapCensus( void )
993
{
994
  nat g, s;
995
996
997
998
999
1000
  Census *census;

  census = &censuses[era];
  census->time  = mut_user_time();
    
  // calculate retainer sets if necessary
1001
#ifdef PROFILING
1002
1003
  if (doingRetainerProfiling()) {
      retainerProfile();
1004
1005
1006
  }
#endif

1007
#ifdef PROFILING
1008
  stat_startHeapCensus();
1009
#endif
1010

1011
1012
1013
1014
1015
  // 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();
1016
  heapCensusChain( census, small_alloc_list );
1017
1018

  // Now traverse the heap in each generation/step.
1019
  if (RtsFlags.GcFlags.generations == 1) {
1020
      heapCensusChain( census, g0s0->to_blocks );
1021
1022
1023
  } else {
      for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
	  for (s = 0; s < generations[g].n_steps; s++) {
1024
1025
1026
	      heapCensusChain( census, generations[g].steps[s].blocks );
	      // Are we interested in large objects?  might be
	      // confusing to include the stack in a heap profile.
1027
	      heapCensusChain( census, generations[g].steps[s].large_objects );
1028
	  }
1029
      }
1030
1031
  }

1032
  // dump out the census info
1033
1034
1035
1036
1037
1038
1039
1040
#ifdef PROFILING
    // We can't generate any info for LDV profiling until
    // the end of the run...
    if (!doingLDVProfiling())
	dumpCensus( census );
#else
    dumpCensus( census );
#endif
1041

1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053

  // free our storage, unless we're keeping all the census info for
  // future restriction by biography.
#ifdef PROFILING
  if (RtsFlags.ProfFlags.bioSelector == NULL)
#endif
  {
      freeHashTable( census->hash, NULL/* don't free the elements */ );
      arenaFree( census->arena );
      census->hash = NULL;
      census->arena = NULL;
  }
1054
1055
1056

  // we're into the next time period now
  nextEra();
1057

1058
#ifdef PROFILING
1059
  stat_endHeapCensus();
1060
#endif
1061
1062
1063
1064
}    

#endif /* PROFILING || DEBUG_HEAP_PROF */