1 /* -----------------------------------------------------------------------------
2 * $Id: ProfHeap.c,v 1.24 2001/08/07 19:34:01 ken 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)
21 #include "Profiling.h"
28 #ifdef DEBUG_HEAP_PROF
30 static void initSymbolHash(void);
31 static void clear_table_data(void);
32 static void fprint_data(FILE *fp);
35 /* -----------------------------------------------------------------------------
38 * For profiling by module, constructor or closure type we need to be
39 * able to get from a string describing the category to a structure
40 * containing the counters for that category. The strings aren't
41 * unique (although gcc will do a fairly good job of commoning them up
42 * where possible), so we have a many->one mapping.
44 * We represent the many->one mapping with a hash table. In order to
45 * find the unique counter associated with a string the first time we
46 * encounter a particular string, we need another hash table, mapping
47 * hashed strings to buckets of counters. The string is hashed, then
48 * the bucket is searched for an existing counter for the same
51 * -------------------------------------------------------------------------- */
56 unsigned long mem_resid;
58 struct _ctr *next_bucket;
61 /* Linked list of all existing ctr structs */
64 /* Hash table mapping (char *) -> (struct _ctr) */
65 HashTable *str_to_ctr;
67 /* Hash table mapping hash_t (hashed string) -> (struct _ctr) */
68 HashTable *hashstr_to_ctrs;
71 initHashTables( void )
73 str_to_ctr = allocHashTable();
74 hashstr_to_ctrs = allocHashTable();
79 strToCtr(const char *str)
83 ctr = lookupHashTable( str_to_ctr, (W_)str );
85 if (ctr != NULL) { return ctr; }
88 hash_t str_hash = hash_str((char *)str);
91 ctr = lookupHashTable( hashstr_to_ctrs, (W_)str_hash );
94 for (; ctr != NULL; prev = ctr, ctr = ctr->next_bucket ) {
95 if (!strcmp(ctr->str, str)) {
96 insertHashTable( str_to_ctr, (W_)str, ctr );
98 fprintf(stderr,"strToCtr: existing ctr for `%s'\n",str);
104 ctr = stgMallocBytes(sizeof(prof_ctr), "strToCtr");
107 ctr->next_bucket = NULL;
108 ctr->next = all_ctrs;
112 fprintf(stderr,"strToCtr: new ctr for `%s'\n",str);
116 prev->next_bucket = ctr;
118 insertHashTable( hashstr_to_ctrs, str_hash, ctr );
120 insertHashTable( str_to_ctr, (W_)str, ctr);
126 clearCtrResid( void )
130 for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
136 reportCtrResid(FILE *fp)
140 for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
141 if (ctr->mem_resid != 0) {
142 fprintf(fp," %s %ld\n", ctr->str, ctr->mem_resid * sizeof(W_));
146 #endif /* PROFILING */
148 /* -------------------------------------------------------------------------- */
150 #ifdef DEBUG_HEAP_PROF
153 void initProfiling1( void )
157 void initProfiling2( void )
162 void endProfiling( void )
166 #endif /* DEBUG_HEAP_PROF */
169 initHeapProfiling(void)
171 if (! RtsFlags.ProfFlags.doHeapProfile) {
175 fprintf(hp_file, "JOB \"%s", prog_argv[0]);
178 switch (RtsFlags.ProfFlags.doHeapProfile) {
179 case HEAP_BY_CCS: fprintf(hp_file, " -h%c", CCchar); break;
180 case HEAP_BY_MOD: fprintf(hp_file, " -h%c", MODchar); break;
181 case HEAP_BY_DESCR: fprintf(hp_file, " -h%c", DESCRchar); break;
182 case HEAP_BY_TYPE: fprintf(hp_file, " -h%c", TYPEchar); break;
183 default: /* nothing */
185 if (RtsFlags.ProfFlags.ccSelector)
186 fprintf(hp_file, " -hc{%s}", RtsFlags.ProfFlags.ccSelector);
187 if (RtsFlags.ProfFlags.modSelector)
188 fprintf(hp_file, " -hm{%s}", RtsFlags.ProfFlags.modSelector);
189 if (RtsFlags.ProfFlags.descrSelector)
190 fprintf(hp_file, " -hd{%s}", RtsFlags.ProfFlags.descrSelector);
191 if (RtsFlags.ProfFlags.typeSelector)
192 fprintf(hp_file, " -hy{%s}", RtsFlags.ProfFlags.typeSelector);
193 # endif /* PROFILING */
195 fprintf(hp_file, "\"\n" );
197 fprintf(hp_file, "DATE \"%s\"\n", time_str());
199 fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
200 fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
202 fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
203 fprintf(hp_file, "END_SAMPLE 0.00\n");
205 #ifdef DEBUG_HEAP_PROF
206 DEBUG_LoadSymbols(prog_argv[0]);
218 endHeapProfiling(void)
222 if (! RtsFlags.ProfFlags.doHeapProfile) {
226 seconds = mut_user_time();
227 fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
228 fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
232 #ifdef DEBUG_HEAP_PROF
233 /* -----------------------------------------------------------------------------
234 Hash table for symbols.
235 -------------------------------------------------------------------------- */
243 #define SYMBOL_HASH_SIZE 0x3fff
245 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
250 return ((W_)ptr)>>4 & 0x3fff;
258 for (i=0; i < SYMBOL_HASH_SIZE; i++) {
259 symbol_hash[i].ptr = NULL;
264 lookup_symbol(void *addr)
266 nat orig_bucket = hash(addr);
269 bucket = orig_bucket;
270 while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
271 if (symbol_hash[bucket].ptr == addr) {
276 if (bucket == SYMBOL_HASH_SIZE) {
278 while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
279 if (symbol_hash[bucket].ptr == addr) {
284 if (bucket == orig_bucket) {
285 barf("out of symbol table space");
289 symbol_hash[bucket].ptr = addr;
290 lookupGHCName(addr,&symbol_hash[bucket].name);
291 symbol_hash[bucket].data = 0;
296 clear_table_data(void)
300 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
301 symbol_hash[i].data = 0;
306 fprint_data(FILE *fp)
309 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
310 if (symbol_hash[i].data > 0) {
311 fprintf(fp, " %s %lu\n", symbol_hash[i].name, (unsigned long)symbol_hash[i].data);
317 add_data(void *addr, nat data)
319 symbol_hash[lookup_symbol(addr)].data += data;
322 /* -----------------------------------------------------------------------------
323 Closure Type Profiling;
325 PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
326 -------------------------------------------------------------------------- */
328 static nat closure_types[N_CLOSURE_TYPES];
330 static char *type_names[] = {
336 , "CONSTR_NOCAF_STATIC"
374 , "MUT_ARR_PTRS_FROZEN"
389 fprint_closure_types(FILE *fp)
393 for (i = 0; i < N_CLOSURE_TYPES; i++) {
394 if (closure_types[i]) {
395 fprintf(fp, " %s %lu\n", type_names[i], (unsigned long)closure_types[i]);
400 #endif /* DEBUG_HEAP_PROF */
405 clearCCSResid(CostCentreStack *ccs)
411 for (i = ccs->indexTable; i != 0; i = i->next) {
413 clearCCSResid(i->ccs);
419 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
422 CostCentreStack *prev;
425 prev = ccs->prevStack;
428 || prev->cc->is_caf != CC_IS_BORING
429 || components == 1) {
430 fprintf(fp,"%s",cc->label);
434 fprint_ccs(fp, ccs->prevStack,components-1);
435 fprintf(fp,"/%s",cc->label);
440 reportCCSResid(FILE *fp, CostCentreStack *ccs)
444 if (ccs->mem_resid != 0) {
446 fprint_ccs(fp,ccs,2/*print 2 components only*/);
447 fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
450 for (i = ccs->indexTable; i != 0; i = i->next) {
452 reportCCSResid(fp,i->ccs);
458 rtsBool str_matches_selector ( char* str, char* sel )
461 /* fprintf(stderr, "str_matches_selector %s %s\n", str, sel); */
463 /* Compare str against wherever we've got to in sel. */
465 while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
468 /* Match if all of str used and have reached the end of a sel
470 if (*p == '\0' && (*sel == ',' || *sel == '\0'))
473 /* No match. Advance sel to the start of the next elem. */
474 while (*sel != ',' && *sel != '\0') sel++;
475 if (*sel == ',') sel++;
477 /* Run out of sel ?? */
478 if (*sel == '\0') return rtsFalse;
482 /* Figure out whether a closure should be counted in this census, by
483 testing against all the specified constraints. */
485 rtsBool satisfies_constraints ( StgClosure* p )
488 if (RtsFlags.ProfFlags.modSelector) {
489 b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module,
490 RtsFlags.ProfFlags.modSelector );
491 if (!b) return rtsFalse;
493 if (RtsFlags.ProfFlags.descrSelector) {
494 b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_desc,
495 RtsFlags.ProfFlags.descrSelector );
496 if (!b) return rtsFalse;
498 if (RtsFlags.ProfFlags.typeSelector) {
499 b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_type,
500 RtsFlags.ProfFlags.typeSelector );
501 if (!b) return rtsFalse;
503 if (RtsFlags.ProfFlags.ccSelector) {
504 b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->label,
505 RtsFlags.ProfFlags.ccSelector );
506 if (!b) return rtsFalse;
510 #endif /* PROFILING */
513 static double time_of_last_heapCensus = 0.0;
519 const StgInfoTable *info;
527 #ifdef DEBUG_HEAP_PROF
528 switch (RtsFlags.ProfFlags.doHeapProfile) {
529 case HEAP_BY_INFOPTR:
532 case HEAP_BY_CLOSURE_TYPE:
535 memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
545 * We only continue iff we've waited long enough,
546 * otherwise, we just dont do the census.
549 time = mut_user_time_during_GC();
550 elapsed = (time - time_of_last_heapCensus) * 1000;
551 if (elapsed < RtsFlags.ProfFlags.profileFrequency) {
554 time_of_last_heapCensus = time;
559 switch (RtsFlags.ProfFlags.doHeapProfile) {
560 case NO_HEAP_PROFILING:
563 /* zero all the residency counters */
564 clearCCSResid(CCS_MAIN);
572 barf("heapCensus; doHeapProfile");
576 /* Only do heap profiling in a two-space heap */
577 ASSERT(RtsFlags.GcFlags.generations == 1);
578 bd = g0s0->to_blocks;
580 fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
584 while (p < bd->free) {
585 info = get_itbl((StgClosure *)p);
587 switch (info->type) {
590 if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info
591 && !(LOOKS_LIKE_GHC_INFO(*(p + sizeW_fromITBL(info))))) {
592 size = sizeofW(StgWeak);
595 /* else, fall through... */
601 case IND_OLDGEN_PERM:
603 case SE_CAF_BLACKHOLE:
613 case CONSTR_CHARLIKE:
627 size = sizeW_fromITBL(info);
630 case THUNK_1_0: /* ToDo - shouldn't be here */
631 case THUNK_0_1: /* " ditto " */
633 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
636 case AP_UPD: /* we can treat this as being the same as a PAP */
638 size = pap_sizeW((StgPAP *)p);
642 size = arr_words_sizeW(stgCast(StgArrWords*,p));
646 case MUT_ARR_PTRS_FROZEN:
647 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
651 size = tso_sizeW((StgTSO *)p);
658 #ifdef DEBUG_HEAP_PROF
659 switch (RtsFlags.ProfFlags.doHeapProfile) {
660 case HEAP_BY_INFOPTR:
661 add_data((void *)(*p), size * sizeof(W_));
663 case HEAP_BY_CLOSURE_TYPE:
664 closure_types[info->type] += size * sizeof(W_);
670 if (satisfies_constraints((StgClosure*)p)) {
671 switch (RtsFlags.ProfFlags.doHeapProfile) {
673 ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
676 strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
680 strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
684 strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
688 barf("heapCensus; doHeapProfile");
698 #ifdef DEBUG_HEAP_PROF
699 switch (RtsFlags.ProfFlags.doHeapProfile) {
700 case HEAP_BY_INFOPTR:
701 fprint_data(hp_file);
703 case HEAP_BY_CLOSURE_TYPE:
704 fprint_closure_types(hp_file);
710 switch (RtsFlags.ProfFlags.doHeapProfile) {
712 reportCCSResid(hp_file,CCS_MAIN);
717 reportCtrResid(hp_file);
720 barf("heapCensus; doHeapProfile");
724 fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
727 #endif /* PROFILING || DEBUG_HEAP_PROF */