1 /* -----------------------------------------------------------------------------
2 * $Id: ProfHeap.c,v 1.25 2001/08/14 13:40:09 sewardj Exp $
4 * (c) The GHC Team, 1998-2000
6 * Support for heap profiling
8 * ---------------------------------------------------------------------------*/
10 #if defined(DEBUG) && !defined(PROFILING)
11 #define DEBUG_HEAP_PROF
13 #undef DEBUG_HEAP_PROF
16 #if defined(PROFILING) || defined(DEBUG_HEAP_PROF)
18 #include "PosixSource.h"
22 #include "Profiling.h"
29 #ifdef DEBUG_HEAP_PROF
31 static void initSymbolHash(void);
32 static void clear_table_data(void);
33 static void fprint_data(FILE *fp);
36 /* -----------------------------------------------------------------------------
39 * For profiling by module, constructor or closure type we need to be
40 * able to get from a string describing the category to a structure
41 * containing the counters for that category. The strings aren't
42 * unique (although gcc will do a fairly good job of commoning them up
43 * where possible), so we have a many->one mapping.
45 * We represent the many->one mapping with a hash table. In order to
46 * find the unique counter associated with a string the first time we
47 * encounter a particular string, we need another hash table, mapping
48 * hashed strings to buckets of counters. The string is hashed, then
49 * the bucket is searched for an existing counter for the same
52 * -------------------------------------------------------------------------- */
57 unsigned long mem_resid;
59 struct _ctr *next_bucket;
62 /* Linked list of all existing ctr structs */
65 /* Hash table mapping (char *) -> (struct _ctr) */
66 HashTable *str_to_ctr;
68 /* Hash table mapping hash_t (hashed string) -> (struct _ctr) */
69 HashTable *hashstr_to_ctrs;
72 initHashTables( void )
74 str_to_ctr = allocHashTable();
75 hashstr_to_ctrs = allocHashTable();
80 strToCtr(const char *str)
84 ctr = lookupHashTable( str_to_ctr, (W_)str );
86 if (ctr != NULL) { return ctr; }
89 hash_t str_hash = hash_str((char *)str);
92 ctr = lookupHashTable( hashstr_to_ctrs, (W_)str_hash );
95 for (; ctr != NULL; prev = ctr, ctr = ctr->next_bucket ) {
96 if (!strcmp(ctr->str, str)) {
97 insertHashTable( str_to_ctr, (W_)str, ctr );
99 fprintf(stderr,"strToCtr: existing ctr for `%s'\n",str);
105 ctr = stgMallocBytes(sizeof(prof_ctr), "strToCtr");
108 ctr->next_bucket = NULL;
109 ctr->next = all_ctrs;
113 fprintf(stderr,"strToCtr: new ctr for `%s'\n",str);
117 prev->next_bucket = ctr;
119 insertHashTable( hashstr_to_ctrs, str_hash, ctr );
121 insertHashTable( str_to_ctr, (W_)str, ctr);
127 clearCtrResid( void )
131 for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
137 reportCtrResid(FILE *fp)
141 for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
142 if (ctr->mem_resid != 0) {
143 fprintf(fp," %s %ld\n", ctr->str, ctr->mem_resid * sizeof(W_));
147 #endif /* PROFILING */
149 /* -------------------------------------------------------------------------- */
151 #ifdef DEBUG_HEAP_PROF
154 void initProfiling1( void )
158 void initProfiling2( void )
163 void endProfiling( void )
167 #endif /* DEBUG_HEAP_PROF */
170 initHeapProfiling(void)
172 if (! RtsFlags.ProfFlags.doHeapProfile) {
176 fprintf(hp_file, "JOB \"%s", prog_argv[0]);
179 switch (RtsFlags.ProfFlags.doHeapProfile) {
180 case HEAP_BY_CCS: fprintf(hp_file, " -h%c", CCchar); break;
181 case HEAP_BY_MOD: fprintf(hp_file, " -h%c", MODchar); break;
182 case HEAP_BY_DESCR: fprintf(hp_file, " -h%c", DESCRchar); break;
183 case HEAP_BY_TYPE: fprintf(hp_file, " -h%c", TYPEchar); break;
184 default: /* nothing */
186 if (RtsFlags.ProfFlags.ccSelector)
187 fprintf(hp_file, " -hc{%s}", RtsFlags.ProfFlags.ccSelector);
188 if (RtsFlags.ProfFlags.modSelector)
189 fprintf(hp_file, " -hm{%s}", RtsFlags.ProfFlags.modSelector);
190 if (RtsFlags.ProfFlags.descrSelector)
191 fprintf(hp_file, " -hd{%s}", RtsFlags.ProfFlags.descrSelector);
192 if (RtsFlags.ProfFlags.typeSelector)
193 fprintf(hp_file, " -hy{%s}", RtsFlags.ProfFlags.typeSelector);
194 # endif /* PROFILING */
196 fprintf(hp_file, "\"\n" );
198 fprintf(hp_file, "DATE \"%s\"\n", time_str());
200 fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
201 fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
203 fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
204 fprintf(hp_file, "END_SAMPLE 0.00\n");
206 #ifdef DEBUG_HEAP_PROF
207 DEBUG_LoadSymbols(prog_argv[0]);
219 endHeapProfiling(void)
223 if (! RtsFlags.ProfFlags.doHeapProfile) {
227 seconds = mut_user_time();
228 fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
229 fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
233 #ifdef DEBUG_HEAP_PROF
234 /* -----------------------------------------------------------------------------
235 Hash table for symbols.
236 -------------------------------------------------------------------------- */
244 #define SYMBOL_HASH_SIZE 0x3fff
246 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
251 return ((W_)ptr)>>4 & 0x3fff;
259 for (i=0; i < SYMBOL_HASH_SIZE; i++) {
260 symbol_hash[i].ptr = NULL;
265 lookup_symbol(void *addr)
267 nat orig_bucket = hash(addr);
270 bucket = orig_bucket;
271 while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
272 if (symbol_hash[bucket].ptr == addr) {
277 if (bucket == SYMBOL_HASH_SIZE) {
279 while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
280 if (symbol_hash[bucket].ptr == addr) {
285 if (bucket == orig_bucket) {
286 barf("out of symbol table space");
290 symbol_hash[bucket].ptr = addr;
291 lookupGHCName(addr,&symbol_hash[bucket].name);
292 symbol_hash[bucket].data = 0;
297 clear_table_data(void)
301 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
302 symbol_hash[i].data = 0;
307 fprint_data(FILE *fp)
310 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
311 if (symbol_hash[i].data > 0) {
312 fprintf(fp, " %s %lu\n", symbol_hash[i].name, (unsigned long)symbol_hash[i].data);
318 add_data(void *addr, nat data)
320 symbol_hash[lookup_symbol(addr)].data += data;
323 /* -----------------------------------------------------------------------------
324 Closure Type Profiling;
326 PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
327 -------------------------------------------------------------------------- */
329 static nat closure_types[N_CLOSURE_TYPES];
331 static char *type_names[] = {
337 , "CONSTR_NOCAF_STATIC"
375 , "MUT_ARR_PTRS_FROZEN"
390 fprint_closure_types(FILE *fp)
394 for (i = 0; i < N_CLOSURE_TYPES; i++) {
395 if (closure_types[i]) {
396 fprintf(fp, " %s %lu\n", type_names[i], (unsigned long)closure_types[i]);
401 #endif /* DEBUG_HEAP_PROF */
406 clearCCSResid(CostCentreStack *ccs)
412 for (i = ccs->indexTable; i != 0; i = i->next) {
414 clearCCSResid(i->ccs);
420 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
423 CostCentreStack *prev;
426 prev = ccs->prevStack;
429 || prev->cc->is_caf != CC_IS_BORING
430 || components == 1) {
431 fprintf(fp,"%s",cc->label);
435 fprint_ccs(fp, ccs->prevStack,components-1);
436 fprintf(fp,"/%s",cc->label);
441 reportCCSResid(FILE *fp, CostCentreStack *ccs)
445 if (ccs->mem_resid != 0) {
447 fprint_ccs(fp,ccs,2/*print 2 components only*/);
448 fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
451 for (i = ccs->indexTable; i != 0; i = i->next) {
453 reportCCSResid(fp,i->ccs);
459 rtsBool str_matches_selector ( char* str, char* sel )
462 /* fprintf(stderr, "str_matches_selector %s %s\n", str, sel); */
464 /* Compare str against wherever we've got to in sel. */
466 while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
469 /* Match if all of str used and have reached the end of a sel
471 if (*p == '\0' && (*sel == ',' || *sel == '\0'))
474 /* No match. Advance sel to the start of the next elem. */
475 while (*sel != ',' && *sel != '\0') sel++;
476 if (*sel == ',') sel++;
478 /* Run out of sel ?? */
479 if (*sel == '\0') return rtsFalse;
483 /* Figure out whether a closure should be counted in this census, by
484 testing against all the specified constraints. */
486 rtsBool satisfies_constraints ( StgClosure* p )
489 if (RtsFlags.ProfFlags.modSelector) {
490 b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module,
491 RtsFlags.ProfFlags.modSelector );
492 if (!b) return rtsFalse;
494 if (RtsFlags.ProfFlags.descrSelector) {
495 b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_desc,
496 RtsFlags.ProfFlags.descrSelector );
497 if (!b) return rtsFalse;
499 if (RtsFlags.ProfFlags.typeSelector) {
500 b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_type,
501 RtsFlags.ProfFlags.typeSelector );
502 if (!b) return rtsFalse;
504 if (RtsFlags.ProfFlags.ccSelector) {
505 b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->label,
506 RtsFlags.ProfFlags.ccSelector );
507 if (!b) return rtsFalse;
511 #endif /* PROFILING */
514 static double time_of_last_heapCensus = 0.0;
520 const StgInfoTable *info;
528 #ifdef DEBUG_HEAP_PROF
529 switch (RtsFlags.ProfFlags.doHeapProfile) {
530 case HEAP_BY_INFOPTR:
533 case HEAP_BY_CLOSURE_TYPE:
536 memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
546 * We only continue iff we've waited long enough,
547 * otherwise, we just dont do the census.
550 time = mut_user_time_during_GC();
551 elapsed = (time - time_of_last_heapCensus) * 1000;
552 if (elapsed < RtsFlags.ProfFlags.profileFrequency) {
555 time_of_last_heapCensus = time;
560 switch (RtsFlags.ProfFlags.doHeapProfile) {
561 case NO_HEAP_PROFILING:
564 /* zero all the residency counters */
565 clearCCSResid(CCS_MAIN);
573 barf("heapCensus; doHeapProfile");
577 /* Only do heap profiling in a two-space heap */
578 ASSERT(RtsFlags.GcFlags.generations == 1);
579 bd = g0s0->to_blocks;
581 fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
585 while (p < bd->free) {
586 info = get_itbl((StgClosure *)p);
588 switch (info->type) {
591 if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info
592 && !(LOOKS_LIKE_GHC_INFO(*(p + sizeW_fromITBL(info))))) {
593 size = sizeofW(StgWeak);
596 /* else, fall through... */
602 case IND_OLDGEN_PERM:
604 case SE_CAF_BLACKHOLE:
614 case CONSTR_CHARLIKE:
628 size = sizeW_fromITBL(info);
631 case THUNK_1_0: /* ToDo - shouldn't be here */
632 case THUNK_0_1: /* " ditto " */
634 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
637 case AP_UPD: /* we can treat this as being the same as a PAP */
639 size = pap_sizeW((StgPAP *)p);
643 size = arr_words_sizeW(stgCast(StgArrWords*,p));
647 case MUT_ARR_PTRS_FROZEN:
648 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
652 size = tso_sizeW((StgTSO *)p);
659 #ifdef DEBUG_HEAP_PROF
660 switch (RtsFlags.ProfFlags.doHeapProfile) {
661 case HEAP_BY_INFOPTR:
662 add_data((void *)(*p), size * sizeof(W_));
664 case HEAP_BY_CLOSURE_TYPE:
665 closure_types[info->type] += size * sizeof(W_);
671 if (satisfies_constraints((StgClosure*)p)) {
672 switch (RtsFlags.ProfFlags.doHeapProfile) {
674 ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
677 strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
681 strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
685 strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
689 barf("heapCensus; doHeapProfile");
699 #ifdef DEBUG_HEAP_PROF
700 switch (RtsFlags.ProfFlags.doHeapProfile) {
701 case HEAP_BY_INFOPTR:
702 fprint_data(hp_file);
704 case HEAP_BY_CLOSURE_TYPE:
705 fprint_closure_types(hp_file);
711 switch (RtsFlags.ProfFlags.doHeapProfile) {
713 reportCCSResid(hp_file,CCS_MAIN);
718 reportCtrResid(hp_file);
721 barf("heapCensus; doHeapProfile");
725 fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
728 #endif /* PROFILING || DEBUG_HEAP_PROF */