ProfHeap.c 28.8 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
#include "Hash.h"
26
27
#include "RetainerProfile.h"
#include "LdvProfile.h"
28
#include "Arena.h"
29
30
#include "Printer.h"

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

35
/* -----------------------------------------------------------------------------
36
37
 * era stores the current time period.  It is the same as the
 * number of censuses that have been performed.
38
 *
39
40
41
 * RESTRICTION:
 *   era must be no longer than LDV_SHIFT (15 or 30) bits.
 * Invariants:
42
 *   era is initialized to 1 in initHeapProfiling().
43
 *
44
45
46
 * 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.
47
 * -------------------------------------------------------------------------- */
48
unsigned int era;
49
static nat max_era;
50

51
/* -----------------------------------------------------------------------------
52
53
54
55
56
57
58
 * 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.
 * -------------------------------------------------------------------------- */
59
60
61
62
63
64
typedef struct _counter {
    void *identity;
    union {
	nat resid;
	struct {
	    int prim;     // total size of 'inherently used' closures
65
	    int not_used; // total size of 'never used' closures
66
	    int used;     // total size of 'used at least once' closures
67
68
	    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'
69
70
71
72
	} ldv;
    } c;
    struct _counter *next;
} counter;
73

sof's avatar
sof committed
74
STATIC_INLINE void
75
76
77
78
79
80
81
82
83
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;
}

84
85
86
87
88
89
90
91
92
93
94
95
96
97
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;

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

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
#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"
130
131
    , "AP_STACK"
    , "AP"
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155

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

156
157
    , "MUT_ARR_PTRS_CLEAN"
    , "MUT_ARR_PTRS_DIRTY"
158
    , "MUT_ARR_PTRS_FROZEN"
159
160
    , "MUT_VAR_CLEAN"
    , "MUT_VAR_DIRTY"
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

    , "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
179
STATIC_INLINE void *
180
181
182
183
184
185
closureIdentity( StgClosure *p )
{
    switch (RtsFlags.ProfFlags.doHeapProfile) {

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

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

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

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

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

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

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

249
250
    if (era > 0 && closureSatisfiesConstraints(c)) {
	size -= sizeofW(StgProfHeader);
251
	ASSERT(LDVW(c) != 0);
252
253
254
	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
/* --------------------------------------------------------------------------
 * Initialize censuses[era];
 * ----------------------------------------------------------------------- */
sof's avatar
sof committed
307
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
	    errorBelch("maximum number of censuses reached; use +RTS -i to reduce");
334
	    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
static char *hp_filename;
355

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

void initProfiling2( void )
361
{
362
363
364
365
366
367
368
  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) {
369
      debugBelch("Can't open profiling report file %s\n", 
370
371
372
373
374
375
	      hp_filename);
      RtsFlags.ProfFlags.doHeapProfile = 0;
      return;
    }
  }
  
376
377
378
379
380
381
382
383
384
  initHeapProfiling();
}

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

385
386
387
388
389
390
391
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"),
Simon Marlow's avatar
Simon Marlow committed
392
            (int)integralPart, (int)(fractionalPart * 100));
393
394
}

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

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

412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
    // 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");

433
434
    initEra( &censuses[era] );

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

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

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

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

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

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

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

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

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

void
endHeapProfiling(void)
{
    StgDouble seconds;

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

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

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

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



#ifdef PROFILING
507
508
509
510
511
512
513
514
515
516
517
518
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;
}

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

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

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

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

535
536
537
    // 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) {
538

539
540
541
	// 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")) {
542
543
	    p += buf_append(p, ccs->cc->module, buf_end);
	    p += buf_append(p, ".CAF", buf_end);
544
545
	} else {
	    if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
546
		p += buf_append(p, "/", buf_end);
547
	    }
548
	    p += buf_append(p, ccs->cc->label, buf_end);
549
	}
550
551
	
	if (p >= buf_end) {
552
553
554
555
556
	    sprintf(buf+max_length-4, "...");
	    break;
	}
    }
    fprintf(fp, "%s", buf);
557
}
558
#endif /* PROFILING */
559

560
561
rtsBool
strMatchesSelector( char* str, char* sel )
562
563
{
   char* p;
564
   // debugBelch("str_matches_selector %s %s\n", str, sel);
565
   while (1) {
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
       // 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;
581
582
583
   }
}

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

   // 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;
602
   }
603

604
   if (RtsFlags.ProfFlags.descrSelector) {
605
       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
606
607
				 RtsFlags.ProfFlags.descrSelector );
       if (!b) return rtsFalse;
608
609
   }
   if (RtsFlags.ProfFlags.typeSelector) {
610
       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
611
                                RtsFlags.ProfFlags.typeSelector );
612
       if (!b) return rtsFalse;
613
   }
614
615
616
   if (RtsFlags.ProfFlags.retainerSelector) {
       RetainerSet *rs;
       nat i;
617
618
619
620
621
622
623
624
625
626
627
628
       // 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;
	       }
629
630
631
632
	   }
       }
       return rtsFalse;
   }
633
634
   return rtsTrue;
#endif /* PROFILING */
635
}
636

637
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
/* -----------------------------------------------------------------------------
 * 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;
663
664
	    ASSERT( censuses[t].void_total <= censuses[t].not_used );
	    ASSERT( censuses[t].drag_total <= censuses[t].used );
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
	}
	
	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);

693
694
		// debugCCS(c->identity);
		// debugBelch(" census=%d void_total=%d drag_total=%d\n",
695
696
697
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
		//         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

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

739
    printSample(rtsTrue, census->time);
740

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

757
    for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
758
759

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

776
	ASSERT( count >= 0 );
777

778
	if (count == 0) continue;
779
780
781
782

#ifdef DEBUG_HEAP_PROF
	switch (RtsFlags.ProfFlags.doHeapProfile) {
	case HEAP_BY_INFOPTR:
783
	    fprintf(hp_file, "%s", lookupGHCName(ctr->identity));
784
785
	    break;
	case HEAP_BY_CLOSURE_TYPE:
786
	    fprintf(hp_file, "%s", (char *)ctr->identity);
787
788
789
790
791
792
793
	    break;
	}
#endif
	
#ifdef PROFILING
	switch (RtsFlags.ProfFlags.doHeapProfile) {
	case HEAP_BY_CCS:
794
	    fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, 25);
795
796
797
798
799
800
801
802
803
804
	    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;

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

811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
	    // 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

829
	fprintf(hp_file, "\t%lu\n", (unsigned long)count * sizeof(W_));
830
831
    }

832
    printSample(rtsFalse, census->time);
833
834
}

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

849
    for (; bd != NULL; bd = bd->link) {
850
851
852
853
854
855
856
857
858

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

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

866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
	    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;

882
883
884
	    case CONSTR:
	    case FUN:
	    case IND_PERM:
885
	    case IND_OLDGEN:
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
	    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;
		
906
907
908
909
910
911
912
913
914
915
916
	    case IND:
		// Special case/Delicate Hack: INDs don't normally
		// appear, since we're doing this heap census right
		// after GC.  However, GarbageCollect() also does
		// resurrectThreads(), which can update some
		// blackholes when it calls raiseAsync() on the
		// resurrected threads.  So we know that any IND will
		// be the size of a BLACKHOLE.
		size = BLACKHOLE_sizeW();
		break;

917
	    case BCO:
918
919
920
921
		prim = rtsTrue;
		size = bco_sizeW((StgBCO *)p);
		break;

922
923
924
	    case MVAR:
	    case WEAK:
	    case STABLE_NAME:
925
926
	    case MUT_VAR_CLEAN:
	    case MUT_VAR_DIRTY:
927
928
929
930
		prim = rtsTrue;
		size = sizeW_fromITBL(info);
		break;

931
932
	    case AP:
		size = ap_sizeW((StgAP *)p);
933
934
935
936
937
		break;

	    case PAP:
		size = pap_sizeW((StgPAP *)p);
		break;
938
939
940
941

	    case AP_STACK:
		size = ap_stack_sizeW((StgAP_STACK *)p);
		break;
942
943
		
	    case ARR_WORDS:
944
		prim = rtsTrue;
945
946
947
		size = arr_words_sizeW(stgCast(StgArrWords*,p));
		break;
		
948
949
	    case MUT_ARR_PTRS_CLEAN:
	    case MUT_ARR_PTRS_DIRTY:
950
	    case MUT_ARR_PTRS_FROZEN:
951
	    case MUT_ARR_PTRS_FROZEN0:
952
		prim = rtsTrue;
953
954
955
956
		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
		break;
		
	    case TSO:
957
		prim = rtsTrue;
958
959
960
961
#ifdef DEBUG_HEAP_PROF
		size = tso_sizeW((StgTSO *)p);
		break;
#else
962
963
964
965
966
967
968
969
		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;
		}
970
971
#endif

972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
	    case TREC_HEADER: 
		prim = rtsTrue;
		size = sizeofW(StgTRecHeader);
		break;

	    case TVAR_WAIT_QUEUE:
		prim = rtsTrue;
		size = sizeofW(StgTVarWaitQueue);
		break;
		
	    case TVAR:
		prim = rtsTrue;
		size = sizeofW(StgTVar);
		break;
		
	    case TREC_CHUNK:
		prim = rtsTrue;
		size = sizeofW(StgTRecChunk);
		break;

992
	    default:
993
		barf("heapCensus, unknown object: %d", info->type);
994
995
	    }
	    
996
997
	    identity = NULL;

998
#ifdef DEBUG_HEAP_PROF
999
	    real_size = size;
1000
#else
1001
1002
	    // subtract the profiling overhead
	    real_size = size - sizeofW(StgProfHeader);
1003
#endif
1004
1005

	    if (closureSatisfiesConstraints((StgClosure*)p)) {
1006
1007
#ifdef PROFILING
		if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
1008
1009
1010
1011
1012
1013
		    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;
1014
		} else
1015
#endif
1016
1017
		{
		    identity = closureIdentity((StgClosure *)p);
1018

1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
		    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;
			    }
			}
		    }
1058
1059
1060
		}
	    }

1061
1062
1063
1064
	    p += size;
	}
    }
}
andy's avatar
andy committed
1065

1066
void
1067
heapCensus( void )
1068
{
1069
  nat g, s;
1070
1071
1072
1073
1074
1075
  Census *census;

  census = &censuses[era];
  census->time  = mut_user_time();
    
  // calculate retainer sets if necessary
1076
#ifdef PROFILING
1077
1078
  if (doingRetainerProfiling()) {
      retainerProfile();
1079
1080
1081
  }
#endif

1082
#ifdef PROFILING
1083
  stat_startHeapCensus();
1084
#endif
1085

1086
1087
1088
1089
1090
  // 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();
1091
  heapCensusChain( census, small_alloc_list );
1092
1093

  // Now traverse the heap in each generation/step.
1094
  if (RtsFlags.GcFlags.generations == 1) {
1095
      heapCensusChain( census, g0s0->blocks );
1096
1097
1098
  } else {
      for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
	  for (s = 0; s < generations[g].n_steps; s++) {
1099
1100
1101
	      heapCensusChain( census, generations[g].steps[s].blocks );
	      // Are we interested in large objects?  might be
	      // confusing to include the stack in a heap profile.
1102
	      heapCensusChain( census, generations[g].steps[s].large_objects );
1103
	  }
1104
      }
1105
1106
  }

1107
  // dump out the census info
1108
1109
1110
1111
1112
1113
1114
1115
#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
1116

1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128

  // 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;
  }
1129
1130
1131

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

1133
#ifdef PROFILING
1134
  stat_endHeapCensus();
1135
#endif
1136
1137
1138
1139
}    

#endif /* PROFILING || DEBUG_HEAP_PROF */