Merge ghc-new-co into master branch
[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 freeProfiling (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, RtsFlags.ProfFlags.ccsLength);
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 BLACKHOLE:
880 case BLOCKING_QUEUE:
881 case FUN_1_0:
882 case FUN_0_1:
883 case FUN_1_1:
884 case FUN_0_2:
885 case FUN_2_0:
886 case CONSTR_1_0:
887 case CONSTR_0_1:
888 case CONSTR_1_1:
889 case CONSTR_0_2:
890 case CONSTR_2_0:
891 size = sizeW_fromITBL(info);
892 break;
893
894 case IND:
895 // Special case/Delicate Hack: INDs don't normally
896 // appear, since we're doing this heap census right
897 // after GC. However, GarbageCollect() also does
898 // resurrectThreads(), which can update some
899 // blackholes when it calls raiseAsync() on the
900 // resurrected threads. So we know that any IND will
901 // be the size of a BLACKHOLE.
902 size = BLACKHOLE_sizeW();
903 break;
904
905 case BCO:
906 prim = rtsTrue;
907 size = bco_sizeW((StgBCO *)p);
908 break;
909
910 case MVAR_CLEAN:
911 case MVAR_DIRTY:
912 case WEAK:
913 case PRIM:
914 case MUT_PRIM:
915 case MUT_VAR_CLEAN:
916 case MUT_VAR_DIRTY:
917 prim = rtsTrue;
918 size = sizeW_fromITBL(info);
919 break;
920
921 case AP:
922 size = ap_sizeW((StgAP *)p);
923 break;
924
925 case PAP:
926 size = pap_sizeW((StgPAP *)p);
927 break;
928
929 case AP_STACK:
930 size = ap_stack_sizeW((StgAP_STACK *)p);
931 break;
932
933 case ARR_WORDS:
934 prim = rtsTrue;
935 size = arr_words_sizeW((StgArrWords*)p);
936 break;
937
938 case MUT_ARR_PTRS_CLEAN:
939 case MUT_ARR_PTRS_DIRTY:
940 case MUT_ARR_PTRS_FROZEN:
941 case MUT_ARR_PTRS_FROZEN0:
942 prim = rtsTrue;
943 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
944 break;
945
946 case TSO:
947 prim = rtsTrue;
948 #ifdef PROFILING
949 if (RtsFlags.ProfFlags.includeTSOs) {
950 size = sizeofW(StgTSO);
951 break;
952 } else {
953 // Skip this TSO and move on to the next object
954 p += sizeofW(StgTSO);
955 continue;
956 }
957 #else
958 size = sizeofW(StgTSO);
959 break;
960 #endif
961
962 case STACK:
963 prim = rtsTrue;
964 #ifdef PROFILING
965 if (RtsFlags.ProfFlags.includeTSOs) {
966 size = stack_sizeW((StgStack*)p);
967 break;
968 } else {
969 // Skip this TSO and move on to the next object
970 p += stack_sizeW((StgStack*)p);
971 continue;
972 }
973 #else
974 size = stack_sizeW((StgStack*)p);
975 break;
976 #endif
977
978 case TREC_CHUNK:
979 prim = rtsTrue;
980 size = sizeofW(StgTRecChunk);
981 break;
982
983 default:
984 barf("heapCensus, unknown object: %d", info->type);
985 }
986
987 identity = NULL;
988
989 #ifdef PROFILING
990 // subtract the profiling overhead
991 real_size = size - sizeofW(StgProfHeader);
992 #else
993 real_size = size;
994 #endif
995
996 if (closureSatisfiesConstraints((StgClosure*)p)) {
997 #ifdef PROFILING
998 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
999 if (prim)
1000 census->prim += real_size;
1001 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1002 census->not_used += real_size;
1003 else
1004 census->used += real_size;
1005 } else
1006 #endif
1007 {
1008 identity = closureIdentity((StgClosure *)p);
1009
1010 if (identity != NULL) {
1011 ctr = lookupHashTable( census->hash, (StgWord)identity );
1012 if (ctr != NULL) {
1013 #ifdef PROFILING
1014 if (RtsFlags.ProfFlags.bioSelector != NULL) {
1015 if (prim)
1016 ctr->c.ldv.prim += real_size;
1017 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1018 ctr->c.ldv.not_used += real_size;
1019 else
1020 ctr->c.ldv.used += real_size;
1021 } else
1022 #endif
1023 {
1024 ctr->c.resid += real_size;
1025 }
1026 } else {
1027 ctr = arenaAlloc( census->arena, sizeof(counter) );
1028 initLDVCtr(ctr);
1029 insertHashTable( census->hash, (StgWord)identity, ctr );
1030 ctr->identity = identity;
1031 ctr->next = census->ctrs;
1032 census->ctrs = ctr;
1033
1034 #ifdef PROFILING
1035 if (RtsFlags.ProfFlags.bioSelector != NULL) {
1036 if (prim)
1037 ctr->c.ldv.prim = real_size;
1038 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1039 ctr->c.ldv.not_used = real_size;
1040 else
1041 ctr->c.ldv.used = real_size;
1042 } else
1043 #endif
1044 {
1045 ctr->c.resid = real_size;
1046 }
1047 }
1048 }
1049 }
1050 }
1051
1052 p += size;
1053 }
1054 }
1055 }
1056
1057 void
1058 heapCensus( void )
1059 {
1060 nat g;
1061 Census *census;
1062
1063 census = &censuses[era];
1064 census->time = mut_user_time();
1065
1066 // calculate retainer sets if necessary
1067 #ifdef PROFILING
1068 if (doingRetainerProfiling()) {
1069 retainerProfile();
1070 }
1071 #endif
1072
1073 #ifdef PROFILING
1074 stat_startHeapCensus();
1075 #endif
1076
1077 // Traverse the heap, collecting the census info
1078 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1079 heapCensusChain( census, generations[g].blocks );
1080 // Are we interested in large objects? might be
1081 // confusing to include the stack in a heap profile.
1082 heapCensusChain( census, generations[g].large_objects );
1083 }
1084
1085 // dump out the census info
1086 #ifdef PROFILING
1087 // We can't generate any info for LDV profiling until
1088 // the end of the run...
1089 if (!doingLDVProfiling())
1090 dumpCensus( census );
1091 #else
1092 dumpCensus( census );
1093 #endif
1094
1095
1096 // free our storage, unless we're keeping all the census info for
1097 // future restriction by biography.
1098 #ifdef PROFILING
1099 if (RtsFlags.ProfFlags.bioSelector == NULL)
1100 {
1101 freeHashTable( census->hash, NULL/* don't free the elements */ );
1102 arenaFree( census->arena );
1103 census->hash = NULL;
1104 census->arena = NULL;
1105 }
1106 #endif
1107
1108 // we're into the next time period now
1109 nextEra();
1110
1111 #ifdef PROFILING
1112 stat_endHeapCensus();
1113 #endif
1114 }
1115