ProfHeap.c 26.9 KB
Newer Older
1
/* -----------------------------------------------------------------------------
sof's avatar
sof committed
2
 * $Id: ProfHeap.c,v 1.47 2003/08/22 22:24:12 sof Exp $
3
 *
4
 * (c) The GHC Team, 1998-2003
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] );

sof's avatar
sof committed
410
    fprintf(hp_file, "JOB \"%s", prog_name);
411

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

#ifdef DEBUG_HEAP_PROF
sof's avatar
sof committed
435
    DEBUG_LoadSymbols(prog_name);
436
437
#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
}



#ifdef PROFILING
482
483
484
485
486
487
488
489
490
491
492
493
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;
}

494
static void
495
fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
496
{
497
    char buf[max_length+1], *p, *buf_end;
498
499
500
501
502
503
504
505
    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;
    }
506

507
508
    fprintf(fp, "(%d)", ccs->ccsID);

509
510
511
    p = buf;
    buf_end = buf + max_length + 1;

512
513
514
    // 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) {
515

516
517
518
	// 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")) {
519
520
	    p += buf_append(p, ccs->cc->module, buf_end);
	    p += buf_append(p, ".CAF", buf_end);
521
522
	} else {
	    if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
523
		p += buf_append(p, "/", buf_end);
524
	    }
525
	    p += buf_append(p, ccs->cc->label, buf_end);
526
	}
527
528
	
	if (p >= buf_end) {
529
530
531
532
533
534
535
	    sprintf(buf+max_length-4, "...");
	    break;
	} else {
	    next_offset += written;
	}
    }
    fprintf(fp, "%s", buf);
536
}
537
#endif // PROFILING
538

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

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

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

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

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

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

719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
#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

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

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

754
	ASSERT( count >= 0 );
755

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

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

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

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

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

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

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

827
828
829
830
    for (; bd != NULL; bd = bd->link) {
	p = bd->start;
	while (p < bd->free) {
	    info = get_itbl((StgClosure *)p);
831
	    prim = rtsFalse;
832
833
834
835
836
837
838
	    
	    switch (info->type) {

	    case CONSTR:
	    case FUN:
	    case THUNK:
	    case IND_PERM:
839
	    case IND_OLDGEN:
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
	    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
	    case BCO:
865
866
867
868
		prim = rtsTrue;
		size = bco_sizeW((StgBCO *)p);
		break;

869
870
871
872
873
874
875
876
877
878
	    case MVAR:
	    case WEAK:
	    case FOREIGN:
	    case STABLE_NAME:
	    case MUT_VAR:
	    case MUT_CONS:
		prim = rtsTrue;
		size = sizeW_fromITBL(info);
		break;

879
880
881
882
883
884
	    case THUNK_1_0:		/* ToDo - shouldn't be here */
	    case THUNK_0_1:		/* "  ditto  " */
	    case THUNK_SELECTOR:
		size = sizeofW(StgHeader) + MIN_UPD_SIZE;
		break;

885
	    case AP:
886
887
888
	    case PAP:
		size = pap_sizeW((StgPAP *)p);
		break;
889
890
891
892

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

921
922
923
924
	    default:
		barf("heapCensus");
	    }
	    
925
926
	    identity = NULL;

927
#ifdef DEBUG_HEAP_PROF
928
	    real_size = size;
929
#else
930
931
	    // subtract the profiling overhead
	    real_size = size - sizeofW(StgProfHeader);
932
#endif
933
934

	    if (closureSatisfiesConstraints((StgClosure*)p)) {
935
936
#ifdef PROFILING
		if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
937
938
939
940
941
942
		    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;
943
		} else
944
#endif
945
946
		{
		    identity = closureIdentity((StgClosure *)p);
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
983
984
985
986
		    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;
			    }
			}
		    }
987
988
989
		}
	    }

990
991
992
993
	    p += size;
	}
    }
}
andy's avatar
andy committed
994

995
void
996
heapCensus( void )
997
{
998
  nat g, s;
999
1000
1001
1002
1003
1004
  Census *census;

  census = &censuses[era];
  census->time  = mut_user_time();
    
  // calculate retainer sets if necessary
1005
#ifdef PROFILING
1006
1007
  if (doingRetainerProfiling()) {
      retainerProfile();
1008
1009
1010
  }
#endif

1011
#ifdef PROFILING
1012
  stat_startHeapCensus();
1013
#endif
1014

1015
1016
1017
1018
1019
  // 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();
1020
  heapCensusChain( census, small_alloc_list );
1021
1022

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

1036
  // dump out the census info
1037
1038
1039
1040
1041
1042
1043
1044
#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
1045

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057

  // 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;
  }
1058
1059
1060

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

1062
#ifdef PROFILING
1063
  stat_endHeapCensus();
1064
#endif
1065
1066
1067
1068
}    

#endif /* PROFILING || DEBUG_HEAP_PROF */