profiling build fix
[ghc.git] / rts / ProfHeap.c
1 /* ----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2003
4 *
5 * Support for heap profiling
6 *
7 * --------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10 #include "Rts.h"
11
12 #include "RtsUtils.h"
13 #include "Profiling.h"
14 #include "ProfHeap.h"
15 #include "Stats.h"
16 #include "Hash.h"
17 #include "RetainerProfile.h"
18 #include "LdvProfile.h"
19 #include "Arena.h"
20 #include "Printer.h"
21
22 #include <string.h>
23
24 /* -----------------------------------------------------------------------------
25 * era stores the current time period. It is the same as the
26 * number of censuses that have been performed.
27 *
28 * RESTRICTION:
29 * era must be no longer than LDV_SHIFT (15 or 30) bits.
30 * Invariants:
31 * era is initialized to 1 in initHeapProfiling().
32 *
33 * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling().
34 * When era reaches max_era, the profiling stops because a closure can
35 * store only up to (max_era - 1) as its creation or last use time.
36 * -------------------------------------------------------------------------- */
37 unsigned int era;
38 static nat max_era;
39
40 /* -----------------------------------------------------------------------------
41 * Counters
42 *
43 * For most heap profiles each closure identity gets a simple count
44 * of live words in the heap at each census. However, if we're
45 * selecting by biography, then we have to keep the various
46 * lag/drag/void counters for each identity.
47 * -------------------------------------------------------------------------- */
48 typedef struct _counter {
49 void *identity;
50 union {
51 nat resid;
52 struct {
53 int prim; // total size of 'inherently used' closures
54 int not_used; // total size of 'never used' closures
55 int used; // total size of 'used at least once' closures
56 int void_total; // current total size of 'destroyed without being used' closures
57 int drag_total; // current total size of 'used at least once and waiting to die'
58 } ldv;
59 } c;
60 struct _counter *next;
61 } counter;
62
63 STATIC_INLINE void
64 initLDVCtr( counter *ctr )
65 {
66 ctr->c.ldv.prim = 0;
67 ctr->c.ldv.not_used = 0;
68 ctr->c.ldv.used = 0;
69 ctr->c.ldv.void_total = 0;
70 ctr->c.ldv.drag_total = 0;
71 }
72
73 typedef struct {
74 double time; // the time in MUT time when the census is made
75 HashTable * hash;
76 counter * ctrs;
77 Arena * arena;
78
79 // for LDV profiling, when just displaying by LDV
80 int prim;
81 int not_used;
82 int used;
83 int void_total;
84 int drag_total;
85 } Census;
86
87 static Census *censuses = NULL;
88 static nat n_censuses = 0;
89
90 #ifdef PROFILING
91 static void aggregateCensusInfo( void );
92 #endif
93
94 static void dumpCensus( Census *census );
95
96 static rtsBool closureSatisfiesConstraints( StgClosure* p );
97
98 /* ----------------------------------------------------------------------------
99 * Find the "closure identity", which is a unique pointer reresenting
100 * the band to which this closure's heap space is attributed in the
101 * heap profile.
102 * ------------------------------------------------------------------------- */
103 static void *
104 closureIdentity( StgClosure *p )
105 {
106 switch (RtsFlags.ProfFlags.doHeapProfile) {
107
108 #ifdef PROFILING
109 case HEAP_BY_CCS:
110 return p->header.prof.ccs;
111 case HEAP_BY_MOD:
112 return p->header.prof.ccs->cc->module;
113 case HEAP_BY_DESCR:
114 return GET_PROF_DESC(get_itbl(p));
115 case HEAP_BY_TYPE:
116 return GET_PROF_TYPE(get_itbl(p));
117 case HEAP_BY_RETAINER:
118 // AFAIK, the only closures in the heap which might not have a
119 // valid retainer set are DEAD_WEAK closures.
120 if (isRetainerSetFieldValid(p))
121 return retainerSetOf(p);
122 else
123 return NULL;
124
125 #else
126 case HEAP_BY_CLOSURE_TYPE:
127 {
128 StgInfoTable *info;
129 info = get_itbl(p);
130 switch (info->type) {
131 case CONSTR:
132 case CONSTR_1_0:
133 case CONSTR_0_1:
134 case CONSTR_2_0:
135 case CONSTR_1_1:
136 case CONSTR_0_2:
137 case CONSTR_STATIC:
138 case CONSTR_NOCAF_STATIC:
139 return GET_CON_DESC(itbl_to_con_itbl(info));
140 default:
141 return closure_type_names[info->type];
142 }
143 }
144
145 #endif
146 default:
147 barf("closureIdentity");
148 }
149 }
150
151 /* --------------------------------------------------------------------------
152 * Profiling type predicates
153 * ----------------------------------------------------------------------- */
154 #ifdef PROFILING
155 STATIC_INLINE rtsBool
156 doingLDVProfiling( void )
157 {
158 return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
159 || RtsFlags.ProfFlags.bioSelector != NULL);
160 }
161
162 STATIC_INLINE rtsBool
163 doingRetainerProfiling( void )
164 {
165 return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
166 || RtsFlags.ProfFlags.retainerSelector != NULL);
167 }
168 #endif /* PROFILING */
169
170 // Precesses a closure 'c' being destroyed whose size is 'size'.
171 // Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
172 // such as TSO; they should not be involved in computing dragNew or voidNew.
173 //
174 // Even though era is checked in both LdvCensusForDead() and
175 // LdvCensusKillAll(), we still need to make sure that era is > 0 because
176 // LDV_recordDead() may be called from elsewhere in the runtime system. E.g.,
177 // when a thunk is replaced by an indirection object.
178
179 #ifdef PROFILING
180 void
181 LDV_recordDead( StgClosure *c, nat size )
182 {
183 void *id;
184 nat t;
185 counter *ctr;
186
187 if (era > 0 && closureSatisfiesConstraints(c)) {
188 size -= sizeofW(StgProfHeader);
189 ASSERT(LDVW(c) != 0);
190 if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
191 t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
192 if (t < era) {
193 if (RtsFlags.ProfFlags.bioSelector == NULL) {
194 censuses[t].void_total += (int)size;
195 censuses[era].void_total -= (int)size;
196 ASSERT(censuses[t].void_total < censuses[t].not_used);
197 } else {
198 id = closureIdentity(c);
199 ctr = lookupHashTable(censuses[t].hash, (StgWord)id);
200 ASSERT( ctr != NULL );
201 ctr->c.ldv.void_total += (int)size;
202 ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
203 if (ctr == NULL) {
204 ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
205 initLDVCtr(ctr);
206 insertHashTable(censuses[era].hash, (StgWord)id, ctr);
207 ctr->identity = id;
208 ctr->next = censuses[era].ctrs;
209 censuses[era].ctrs = ctr;
210 }
211 ctr->c.ldv.void_total -= (int)size;
212 }
213 }
214 } else {
215 t = LDVW((c)) & LDV_LAST_MASK;
216 if (t + 1 < era) {
217 if (RtsFlags.ProfFlags.bioSelector == NULL) {
218 censuses[t+1].drag_total += size;
219 censuses[era].drag_total -= size;
220 } else {
221 void *id;
222 id = closureIdentity(c);
223 ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
224 ASSERT( ctr != NULL );
225 ctr->c.ldv.drag_total += (int)size;
226 ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
227 if (ctr == NULL) {
228 ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
229 initLDVCtr(ctr);
230 insertHashTable(censuses[era].hash, (StgWord)id, ctr);
231 ctr->identity = id;
232 ctr->next = censuses[era].ctrs;
233 censuses[era].ctrs = ctr;
234 }
235 ctr->c.ldv.drag_total -= (int)size;
236 }
237 }
238 }
239 }
240 }
241 #endif
242
243 /* --------------------------------------------------------------------------
244 * Initialize censuses[era];
245 * ----------------------------------------------------------------------- */
246
247 STATIC_INLINE void
248 initEra(Census *census)
249 {
250 census->hash = allocHashTable();
251 census->ctrs = NULL;
252 census->arena = newArena();
253
254 census->not_used = 0;
255 census->used = 0;
256 census->prim = 0;
257 census->void_total = 0;
258 census->drag_total = 0;
259 }
260
261 STATIC_INLINE void
262 freeEra(Census *census)
263 {
264 if (RtsFlags.ProfFlags.bioSelector != NULL)
265 // when bioSelector==NULL, these are freed in heapCensus()
266 {
267 arenaFree(census->arena);
268 freeHashTable(census->hash, NULL);
269 }
270 }
271
272 /* --------------------------------------------------------------------------
273 * Increases era by 1 and initialize census[era].
274 * Reallocates gi[] and increases its size if needed.
275 * ----------------------------------------------------------------------- */
276
277 static void
278 nextEra( void )
279 {
280 #ifdef PROFILING
281 if (doingLDVProfiling()) {
282 era++;
283
284 if (era == max_era) {
285 errorBelch("maximum number of censuses reached; use +RTS -i to reduce");
286 stg_exit(EXIT_FAILURE);
287 }
288
289 if (era == n_censuses) {
290 n_censuses *= 2;
291 censuses = stgReallocBytes(censuses, sizeof(Census) * n_censuses,
292 "nextEra");
293 }
294 }
295 #endif /* PROFILING */
296
297 initEra( &censuses[era] );
298 }
299
300 /* ----------------------------------------------------------------------------
301 * Heap profiling by info table
302 * ------------------------------------------------------------------------- */
303
304 #if !defined(PROFILING)
305 FILE *hp_file;
306 static char *hp_filename;
307
308 void initProfiling1 (void)
309 {
310 }
311
312 void freeProfiling1 (void)
313 {
314 }
315
316 void initProfiling2 (void)
317 {
318 char *prog;
319
320 prog = stgMallocBytes(strlen(prog_name) + 1, "initProfiling2");
321 strcpy(prog, prog_name);
322 #ifdef mingw32_HOST_OS
323 // on Windows, drop the .exe suffix if there is one
324 {
325 char *suff;
326 suff = strrchr(prog,'.');
327 if (suff != NULL && !strcmp(suff,".exe")) {
328 *suff = '\0';
329 }
330 }
331 #endif
332
333 if (RtsFlags.ProfFlags.doHeapProfile) {
334 /* Initialise the log file name */
335 hp_filename = stgMallocBytes(strlen(prog) + 6, "hpFileName");
336 sprintf(hp_filename, "%s.hp", prog);
337
338 /* open the log file */
339 if ((hp_file = fopen(hp_filename, "w")) == NULL) {
340 debugBelch("Can't open profiling report file %s\n",
341 hp_filename);
342 RtsFlags.ProfFlags.doHeapProfile = 0;
343 return;
344 }
345 }
346
347 stgFree(prog);
348
349 initHeapProfiling();
350 }
351
352 void endProfiling( void )
353 {
354 endHeapProfiling();
355 }
356 #endif /* !PROFILING */
357
358 static void
359 printSample(rtsBool beginSample, StgDouble sampleValue)
360 {
361 StgDouble fractionalPart, integralPart;
362 fractionalPart = modf(sampleValue, &integralPart);
363 fprintf(hp_file, "%s %" FMT_Word64 ".%02" FMT_Word64 "\n",
364 (beginSample ? "BEGIN_SAMPLE" : "END_SAMPLE"),
365 (StgWord64)integralPart, (StgWord64)(fractionalPart * 100));
366 }
367
368 /* --------------------------------------------------------------------------
369 * Initialize the heap profilier
370 * ----------------------------------------------------------------------- */
371 nat
372 initHeapProfiling(void)
373 {
374 if (! RtsFlags.ProfFlags.doHeapProfile) {
375 return 0;
376 }
377
378 #ifdef PROFILING
379 if (doingLDVProfiling() && doingRetainerProfiling()) {
380 errorBelch("cannot mix -hb and -hr");
381 stg_exit(EXIT_FAILURE);
382 }
383 #endif
384
385 // we only count eras if we're doing LDV profiling. Otherwise era
386 // is fixed at zero.
387 #ifdef PROFILING
388 if (doingLDVProfiling()) {
389 era = 1;
390 } else
391 #endif
392 {
393 era = 0;
394 }
395
396 // max_era = 2^LDV_SHIFT
397 max_era = 1 << LDV_SHIFT;
398
399 n_censuses = 32;
400 censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");
401
402 initEra( &censuses[era] );
403
404 /* initProfilingLogFile(); */
405 fprintf(hp_file, "JOB \"%s", prog_name);
406
407 #ifdef PROFILING
408 {
409 int count;
410 for(count = 1; count < prog_argc; count++)
411 fprintf(hp_file, " %s", prog_argv[count]);
412 fprintf(hp_file, " +RTS");
413 for(count = 0; count < rts_argc; count++)
414 fprintf(hp_file, " %s", rts_argv[count]);
415 }
416 #endif /* PROFILING */
417
418 fprintf(hp_file, "\"\n" );
419
420 fprintf(hp_file, "DATE \"%s\"\n", time_str());
421
422 fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
423 fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
424
425 printSample(rtsTrue, 0);
426 printSample(rtsFalse, 0);
427
428 #ifdef PROFILING
429 if (doingRetainerProfiling()) {
430 initRetainerProfiling();
431 }
432 #endif
433
434 return 0;
435 }
436
437 void
438 endHeapProfiling(void)
439 {
440 StgDouble seconds;
441
442 if (! RtsFlags.ProfFlags.doHeapProfile) {
443 return;
444 }
445
446 #ifdef PROFILING
447 if (doingRetainerProfiling()) {
448 endRetainerProfiling();
449 }
450 #endif
451
452 #ifdef PROFILING
453 if (doingLDVProfiling()) {
454 nat t;
455 LdvCensusKillAll();
456 aggregateCensusInfo();
457 for (t = 1; t < era; t++) {
458 dumpCensus( &censuses[t] );
459 }
460 }
461 #endif
462
463 #ifdef PROFILING
464 if (doingLDVProfiling()) {
465 nat t;
466 for (t = 1; t <= era; t++) {
467 freeEra( &censuses[t] );
468 }
469 } else {
470 freeEra( &censuses[0] );
471 }
472 #else
473 freeEra( &censuses[0] );
474 #endif
475
476 stgFree(censuses);
477
478 seconds = mut_user_time();
479 printSample(rtsTrue, seconds);
480 printSample(rtsFalse, seconds);
481 fclose(hp_file);
482 }
483
484
485
486 #ifdef PROFILING
487 static size_t
488 buf_append(char *p, const char *q, char *end)
489 {
490 int m;
491
492 for (m = 0; p < end; p++, q++, m++) {
493 *p = *q;
494 if (*q == '\0') { break; }
495 }
496 return m;
497 }
498
499 static void
500 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
501 {
502 char buf[max_length+1], *p, *buf_end;
503
504 // MAIN on its own gets printed as "MAIN", otherwise we ignore MAIN.
505 if (ccs == CCS_MAIN) {
506 fprintf(fp, "MAIN");
507 return;
508 }
509
510 fprintf(fp, "(%ld)", ccs->ccsID);
511
512 p = buf;
513 buf_end = buf + max_length + 1;
514
515 // keep printing components of the stack until we run out of space
516 // in the buffer. If we run out of space, end with "...".
517 for (; ccs != NULL && ccs != CCS_MAIN; ccs = ccs->prevStack) {
518
519 // CAF cost centres print as M.CAF, but we leave the module
520 // name out of all the others to save space.
521 if (!strcmp(ccs->cc->label,"CAF")) {
522 p += buf_append(p, ccs->cc->module, buf_end);
523 p += buf_append(p, ".CAF", buf_end);
524 } else {
525 p += buf_append(p, ccs->cc->label, buf_end);
526 if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
527 p += buf_append(p, "/", buf_end);
528 }
529 }
530
531 if (p >= buf_end) {
532 sprintf(buf+max_length-4, "...");
533 break;
534 }
535 }
536 fprintf(fp, "%s", buf);
537 }
538
539 rtsBool
540 strMatchesSelector( char* str, char* sel )
541 {
542 char* p;
543 // debugBelch("str_matches_selector %s %s\n", str, sel);
544 while (1) {
545 // Compare str against wherever we've got to in sel.
546 p = str;
547 while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
548 p++; sel++;
549 }
550 // Match if all of str used and have reached the end of a sel fragment.
551 if (*p == '\0' && (*sel == ',' || *sel == '\0'))
552 return rtsTrue;
553
554 // No match. Advance sel to the start of the next elem.
555 while (*sel != ',' && *sel != '\0') sel++;
556 if (*sel == ',') sel++;
557
558 /* Run out of sel ?? */
559 if (*sel == '\0') return rtsFalse;
560 }
561 }
562
563 #endif /* PROFILING */
564
565 /* -----------------------------------------------------------------------------
566 * Figure out whether a closure should be counted in this census, by
567 * testing against all the specified constraints.
568 * -------------------------------------------------------------------------- */
569 static rtsBool
570 closureSatisfiesConstraints( StgClosure* p )
571 {
572 #if !defined(PROFILING)
573 (void)p; /* keep gcc -Wall happy */
574 return rtsTrue;
575 #else
576 rtsBool b;
577
578 // The CCS has a selected field to indicate whether this closure is
579 // deselected by not being mentioned in the module, CC, or CCS
580 // selectors.
581 if (!p->header.prof.ccs->selected) {
582 return rtsFalse;
583 }
584
585 if (RtsFlags.ProfFlags.descrSelector) {
586 b = strMatchesSelector( (GET_PROF_DESC(get_itbl((StgClosure *)p))),
587 RtsFlags.ProfFlags.descrSelector );
588 if (!b) return rtsFalse;
589 }
590 if (RtsFlags.ProfFlags.typeSelector) {
591 b = strMatchesSelector( (GET_PROF_TYPE(get_itbl((StgClosure *)p))),
592 RtsFlags.ProfFlags.typeSelector );
593 if (!b) return rtsFalse;
594 }
595 if (RtsFlags.ProfFlags.retainerSelector) {
596 RetainerSet *rs;
597 nat i;
598 // We must check that the retainer set is valid here. One
599 // reason it might not be valid is if this closure is a
600 // a newly deceased weak pointer (i.e. a DEAD_WEAK), since
601 // these aren't reached by the retainer profiler's traversal.
602 if (isRetainerSetFieldValid((StgClosure *)p)) {
603 rs = retainerSetOf((StgClosure *)p);
604 if (rs != NULL) {
605 for (i = 0; i < rs->num; i++) {
606 b = strMatchesSelector( rs->element[i]->cc->label,
607 RtsFlags.ProfFlags.retainerSelector );
608 if (b) return rtsTrue;
609 }
610 }
611 }
612 return rtsFalse;
613 }
614 return rtsTrue;
615 #endif /* PROFILING */
616 }
617
618 /* -----------------------------------------------------------------------------
619 * Aggregate the heap census info for biographical profiling
620 * -------------------------------------------------------------------------- */
621 #ifdef PROFILING
622 static void
623 aggregateCensusInfo( void )
624 {
625 HashTable *acc;
626 nat t;
627 counter *c, *d, *ctrs;
628 Arena *arena;
629
630 if (!doingLDVProfiling()) return;
631
632 // Aggregate the LDV counters when displaying by biography.
633 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
634 int void_total, drag_total;
635
636 // Now we compute void_total and drag_total for each census
637 // After the program has finished, the void_total field of
638 // each census contains the count of words that were *created*
639 // in this era and were eventually void. Conversely, if a
640 // void closure was destroyed in this era, it will be
641 // represented by a negative count of words in void_total.
642 //
643 // To get the count of live words that are void at each
644 // census, just propagate the void_total count forwards:
645
646 void_total = 0;
647 drag_total = 0;
648 for (t = 1; t < era; t++) { // note: start at 1, not 0
649 void_total += censuses[t].void_total;
650 drag_total += censuses[t].drag_total;
651 censuses[t].void_total = void_total;
652 censuses[t].drag_total = drag_total;
653
654 ASSERT( censuses[t].void_total <= censuses[t].not_used );
655 // should be true because: void_total is the count of
656 // live words that are void at this census, which *must*
657 // be less than the number of live words that have not
658 // been used yet.
659
660 ASSERT( censuses[t].drag_total <= censuses[t].used );
661 // similar reasoning as above.
662 }
663
664 return;
665 }
666
667 // otherwise... we're doing a heap profile that is restricted to
668 // some combination of lag, drag, void or use. We've kept all the
669 // census info for all censuses so far, but we still need to
670 // aggregate the counters forwards.
671
672 arena = newArena();
673 acc = allocHashTable();
674 ctrs = NULL;
675
676 for (t = 1; t < era; t++) {
677
678 // first look through all the counters we're aggregating
679 for (c = ctrs; c != NULL; c = c->next) {
680 // if one of the totals is non-zero, then this closure
681 // type must be present in the heap at this census time...
682 d = lookupHashTable(censuses[t].hash, (StgWord)c->identity);
683
684 if (d == NULL) {
685 // if this closure identity isn't present in the
686 // census for this time period, then our running
687 // totals *must* be zero.
688 ASSERT(c->c.ldv.void_total == 0 && c->c.ldv.drag_total == 0);
689
690 // debugCCS(c->identity);
691 // debugBelch(" census=%d void_total=%d drag_total=%d\n",
692 // t, c->c.ldv.void_total, c->c.ldv.drag_total);
693 } else {
694 d->c.ldv.void_total += c->c.ldv.void_total;
695 d->c.ldv.drag_total += c->c.ldv.drag_total;
696 c->c.ldv.void_total = d->c.ldv.void_total;
697 c->c.ldv.drag_total = d->c.ldv.drag_total;
698
699 ASSERT( c->c.ldv.void_total >= 0 );
700 ASSERT( c->c.ldv.drag_total >= 0 );
701 }
702 }
703
704 // now look through the counters in this census to find new ones
705 for (c = censuses[t].ctrs; c != NULL; c = c->next) {
706 d = lookupHashTable(acc, (StgWord)c->identity);
707 if (d == NULL) {
708 d = arenaAlloc( arena, sizeof(counter) );
709 initLDVCtr(d);
710 insertHashTable( acc, (StgWord)c->identity, d );
711 d->identity = c->identity;
712 d->next = ctrs;
713 ctrs = d;
714 d->c.ldv.void_total = c->c.ldv.void_total;
715 d->c.ldv.drag_total = c->c.ldv.drag_total;
716 }
717 ASSERT( c->c.ldv.void_total >= 0 );
718 ASSERT( c->c.ldv.drag_total >= 0 );
719 }
720 }
721
722 freeHashTable(acc, NULL);
723 arenaFree(arena);
724 }
725 #endif
726
727 /* -----------------------------------------------------------------------------
728 * Print out the results of a heap census.
729 * -------------------------------------------------------------------------- */
730 static void
731 dumpCensus( Census *census )
732 {
733 counter *ctr;
734 int count;
735
736 printSample(rtsTrue, census->time);
737
738 #ifdef PROFILING
739 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
740 fprintf(hp_file, "VOID\t%lu\n", (unsigned long)(census->void_total) * sizeof(W_));
741 fprintf(hp_file, "LAG\t%lu\n",
742 (unsigned long)(census->not_used - census->void_total) * sizeof(W_));
743 fprintf(hp_file, "USE\t%lu\n",
744 (unsigned long)(census->used - census->drag_total) * sizeof(W_));
745 fprintf(hp_file, "INHERENT_USE\t%lu\n",
746 (unsigned long)(census->prim) * sizeof(W_));
747 fprintf(hp_file, "DRAG\t%lu\n",
748 (unsigned long)(census->drag_total) * sizeof(W_));
749 printSample(rtsFalse, census->time);
750 return;
751 }
752 #endif
753
754 for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
755
756 #ifdef PROFILING
757 if (RtsFlags.ProfFlags.bioSelector != NULL) {
758 count = 0;
759 if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector))
760 count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
761 if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector))
762 count += ctr->c.ldv.drag_total;
763 if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector))
764 count += ctr->c.ldv.void_total;
765 if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector))
766 count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
767 } else
768 #endif
769 {
770 count = ctr->c.resid;
771 }
772
773 ASSERT( count >= 0 );
774
775 if (count == 0) continue;
776
777 #if !defined(PROFILING)
778 switch (RtsFlags.ProfFlags.doHeapProfile) {
779 case HEAP_BY_CLOSURE_TYPE:
780 fprintf(hp_file, "%s", (char *)ctr->identity);
781 break;
782 }
783 #endif
784
785 #ifdef PROFILING
786 switch (RtsFlags.ProfFlags.doHeapProfile) {
787 case HEAP_BY_CCS:
788 fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, RtsFlags.ProfFlags.ccsLength);
789 break;
790 case HEAP_BY_MOD:
791 case HEAP_BY_DESCR:
792 case HEAP_BY_TYPE:
793 fprintf(hp_file, "%s", (char *)ctr->identity);
794 break;
795 case HEAP_BY_RETAINER:
796 {
797 RetainerSet *rs = (RetainerSet *)ctr->identity;
798
799 // it might be the distinguished retainer set rs_MANY:
800 if (rs == &rs_MANY) {
801 fprintf(hp_file, "MANY");
802 break;
803 }
804
805 // Mark this retainer set by negating its id, because it
806 // has appeared in at least one census. We print the
807 // values of all such retainer sets into the log file at
808 // the end. A retainer set may exist but not feature in
809 // any censuses if it arose as the intermediate retainer
810 // set for some closure during retainer set calculation.
811 if (rs->id > 0)
812 rs->id = -(rs->id);
813
814 // report in the unit of bytes: * sizeof(StgWord)
815 printRetainerSetShort(hp_file, rs);
816 break;
817 }
818 default:
819 barf("dumpCensus; doHeapProfile");
820 }
821 #endif
822
823 fprintf(hp_file, "\t%lu\n", (unsigned long)count * sizeof(W_));
824 }
825
826 printSample(rtsFalse, census->time);
827 }
828
829 /* -----------------------------------------------------------------------------
830 * Code to perform a heap census.
831 * -------------------------------------------------------------------------- */
832 static void
833 heapCensusChain( Census *census, bdescr *bd )
834 {
835 StgPtr p;
836 StgInfoTable *info;
837 void *identity;
838 nat size;
839 counter *ctr;
840 nat real_size;
841 rtsBool prim;
842
843 for (; bd != NULL; bd = bd->link) {
844
845 // HACK: ignore pinned blocks, because they contain gaps.
846 // It's not clear exactly what we'd like to do here, since we
847 // can't tell which objects in the block are actually alive.
848 // Perhaps the whole block should be counted as SYSTEM memory.
849 if (bd->flags & BF_PINNED) {
850 continue;
851 }
852
853 p = bd->start;
854 while (p < bd->free) {
855 info = get_itbl((StgClosure *)p);
856 prim = rtsFalse;
857
858 switch (info->type) {
859
860 case THUNK:
861 size = thunk_sizeW_fromITBL(info);
862 break;
863
864 case THUNK_1_1:
865 case THUNK_0_2:
866 case THUNK_2_0:
867 size = sizeofW(StgThunkHeader) + 2;
868 break;
869
870 case THUNK_1_0:
871 case THUNK_0_1:
872 case THUNK_SELECTOR:
873 size = sizeofW(StgThunkHeader) + 1;
874 break;
875
876 case CONSTR:
877 case FUN:
878 case IND_PERM:
879 case IND_OLDGEN:
880 case IND_OLDGEN_PERM:
881 case CAF_BLACKHOLE:
882 case BLACKHOLE:
883 case FUN_1_0:
884 case FUN_0_1:
885 case FUN_1_1:
886 case FUN_0_2:
887 case FUN_2_0:
888 case CONSTR_1_0:
889 case CONSTR_0_1:
890 case CONSTR_1_1:
891 case CONSTR_0_2:
892 case CONSTR_2_0:
893 size = sizeW_fromITBL(info);
894 break;
895
896 case IND:
897 // Special case/Delicate Hack: INDs don't normally
898 // appear, since we're doing this heap census right
899 // after GC. However, GarbageCollect() also does
900 // resurrectThreads(), which can update some
901 // blackholes when it calls raiseAsync() on the
902 // resurrected threads. So we know that any IND will
903 // be the size of a BLACKHOLE.
904 size = BLACKHOLE_sizeW();
905 break;
906
907 case BCO:
908 prim = rtsTrue;
909 size = bco_sizeW((StgBCO *)p);
910 break;
911
912 case MVAR_CLEAN:
913 case MVAR_DIRTY:
914 case WEAK:
915 case STABLE_NAME:
916 case MUT_VAR_CLEAN:
917 case MUT_VAR_DIRTY:
918 prim = rtsTrue;
919 size = sizeW_fromITBL(info);
920 break;
921
922 case AP:
923 size = ap_sizeW((StgAP *)p);
924 break;
925
926 case PAP:
927 size = pap_sizeW((StgPAP *)p);
928 break;
929
930 case AP_STACK:
931 size = ap_stack_sizeW((StgAP_STACK *)p);
932 break;
933
934 case ARR_WORDS:
935 prim = rtsTrue;
936 size = arr_words_sizeW((StgArrWords*)p);
937 break;
938
939 case MUT_ARR_PTRS_CLEAN:
940 case MUT_ARR_PTRS_DIRTY:
941 case MUT_ARR_PTRS_FROZEN:
942 case MUT_ARR_PTRS_FROZEN0:
943 prim = rtsTrue;
944 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
945 break;
946
947 case TSO:
948 prim = rtsTrue;
949 #ifdef PROFILING
950 if (RtsFlags.ProfFlags.includeTSOs) {
951 size = tso_sizeW((StgTSO *)p);
952 break;
953 } else {
954 // Skip this TSO and move on to the next object
955 p += tso_sizeW((StgTSO *)p);
956 continue;
957 }
958 #else
959 size = tso_sizeW((StgTSO *)p);
960 break;
961 #endif
962
963 case TREC_HEADER:
964 prim = rtsTrue;
965 size = sizeofW(StgTRecHeader);
966 break;
967
968 case TVAR_WATCH_QUEUE:
969 prim = rtsTrue;
970 size = sizeofW(StgTVarWatchQueue);
971 break;
972
973 case INVARIANT_CHECK_QUEUE:
974 prim = rtsTrue;
975 size = sizeofW(StgInvariantCheckQueue);
976 break;
977
978 case ATOMIC_INVARIANT:
979 prim = rtsTrue;
980 size = sizeofW(StgAtomicInvariant);
981 break;
982
983 case TVAR:
984 prim = rtsTrue;
985 size = sizeofW(StgTVar);
986 break;
987
988 case TREC_CHUNK:
989 prim = rtsTrue;
990 size = sizeofW(StgTRecChunk);
991 break;
992
993 default:
994 barf("heapCensus, unknown object: %d", info->type);
995 }
996
997 identity = NULL;
998
999 #ifdef PROFILING
1000 // subtract the profiling overhead
1001 real_size = size - sizeofW(StgProfHeader);
1002 #else
1003 real_size = size;
1004 #endif
1005
1006 if (closureSatisfiesConstraints((StgClosure*)p)) {
1007 #ifdef PROFILING
1008 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
1009 if (prim)
1010 census->prim += real_size;
1011 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1012 census->not_used += real_size;
1013 else
1014 census->used += real_size;
1015 } else
1016 #endif
1017 {
1018 identity = closureIdentity((StgClosure *)p);
1019
1020 if (identity != NULL) {
1021 ctr = lookupHashTable( census->hash, (StgWord)identity );
1022 if (ctr != NULL) {
1023 #ifdef PROFILING
1024 if (RtsFlags.ProfFlags.bioSelector != NULL) {
1025 if (prim)
1026 ctr->c.ldv.prim += real_size;
1027 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1028 ctr->c.ldv.not_used += real_size;
1029 else
1030 ctr->c.ldv.used += real_size;
1031 } else
1032 #endif
1033 {
1034 ctr->c.resid += real_size;
1035 }
1036 } else {
1037 ctr = arenaAlloc( census->arena, sizeof(counter) );
1038 initLDVCtr(ctr);
1039 insertHashTable( census->hash, (StgWord)identity, ctr );
1040 ctr->identity = identity;
1041 ctr->next = census->ctrs;
1042 census->ctrs = ctr;
1043
1044 #ifdef PROFILING
1045 if (RtsFlags.ProfFlags.bioSelector != NULL) {
1046 if (prim)
1047 ctr->c.ldv.prim = real_size;
1048 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1049 ctr->c.ldv.not_used = real_size;
1050 else
1051 ctr->c.ldv.used = real_size;
1052 } else
1053 #endif
1054 {
1055 ctr->c.resid = real_size;
1056 }
1057 }
1058 }
1059 }
1060 }
1061
1062 p += size;
1063 }
1064 }
1065 }
1066
1067 void
1068 heapCensus( void )
1069 {
1070 nat g, s;
1071 Census *census;
1072
1073 census = &censuses[era];
1074 census->time = mut_user_time();
1075
1076 // calculate retainer sets if necessary
1077 #ifdef PROFILING
1078 if (doingRetainerProfiling()) {
1079 retainerProfile();
1080 }
1081 #endif
1082
1083 #ifdef PROFILING
1084 stat_startHeapCensus();
1085 #endif
1086
1087 // Traverse the heap, collecting the census info
1088 if (RtsFlags.GcFlags.generations == 1) {
1089 heapCensusChain( census, g0s0->blocks );
1090 } else {
1091 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1092 for (s = 0; s < generations[g].n_steps; s++) {
1093 heapCensusChain( census, generations[g].steps[s].blocks );
1094 // Are we interested in large objects? might be
1095 // confusing to include the stack in a heap profile.
1096 heapCensusChain( census, generations[g].steps[s].large_objects );
1097 }
1098 }
1099 }
1100
1101 // dump out the census info
1102 #ifdef PROFILING
1103 // We can't generate any info for LDV profiling until
1104 // the end of the run...
1105 if (!doingLDVProfiling())
1106 dumpCensus( census );
1107 #else
1108 dumpCensus( census );
1109 #endif
1110
1111
1112 // free our storage, unless we're keeping all the census info for
1113 // future restriction by biography.
1114 #ifdef PROFILING
1115 if (RtsFlags.ProfFlags.bioSelector == NULL)
1116 {
1117 freeHashTable( census->hash, NULL/* don't free the elements */ );
1118 arenaFree( census->arena );
1119 census->hash = NULL;
1120 census->arena = NULL;
1121 }
1122 #endif
1123
1124 // we're into the next time period now
1125 nextEra();
1126
1127 #ifdef PROFILING
1128 stat_endHeapCensus();
1129 #endif
1130 }
1131