1 /* -----------------------------------------------------------------------------
2 * $Id: ProfHeap.c,v 1.21 2001/03/14 11:18:18 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)
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 %d\n", symbol_hash[i].name, 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 %d\n", type_names[i], 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 */
517 const StgInfoTable *info;
522 #ifdef DEBUG_HEAP_PROF
523 switch (RtsFlags.ProfFlags.doHeapProfile) {
524 case HEAP_BY_INFOPTR:
527 case HEAP_BY_CLOSURE_TYPE:
530 memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
539 switch (RtsFlags.ProfFlags.doHeapProfile) {
540 case NO_HEAP_PROFILING:
543 /* zero all the residency counters */
544 clearCCSResid(CCS_MAIN);
552 barf("heapCensus; doHeapProfile");
556 /* Only do heap profiling in a two-space heap */
557 ASSERT(RtsFlags.GcFlags.generations == 1);
560 time = mut_user_time_during_GC();
561 fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
565 while (p < bd->free) {
566 info = get_itbl((StgClosure *)p);
568 switch (info->type) {
571 if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info
572 && !(LOOKS_LIKE_GHC_INFO(*(p + sizeW_fromITBL(info))))) {
573 size = sizeofW(StgWeak);
576 /* else, fall through... */
582 case IND_OLDGEN_PERM:
584 case SE_CAF_BLACKHOLE:
594 case CONSTR_CHARLIKE:
608 size = sizeW_fromITBL(info);
611 case THUNK_1_0: /* ToDo - shouldn't be here */
612 case THUNK_0_1: /* " ditto " */
614 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
617 case AP_UPD: /* we can treat this as being the same as a PAP */
619 size = pap_sizeW((StgPAP *)p);
623 size = arr_words_sizeW(stgCast(StgArrWords*,p));
627 case MUT_ARR_PTRS_FROZEN:
628 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
632 size = tso_sizeW((StgTSO *)p);
639 #ifdef DEBUG_HEAP_PROF
640 switch (RtsFlags.ProfFlags.doHeapProfile) {
641 case HEAP_BY_INFOPTR:
642 add_data((void *)(*p), size * sizeof(W_));
644 case HEAP_BY_CLOSURE_TYPE:
645 closure_types[info->type] += size * sizeof(W_);
651 if (satisfies_constraints((StgClosure*)p)) {
652 switch (RtsFlags.ProfFlags.doHeapProfile) {
654 ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
657 strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
661 strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
665 strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
669 barf("heapCensus; doHeapProfile");
679 #ifdef DEBUG_HEAP_PROF
680 switch (RtsFlags.ProfFlags.doHeapProfile) {
681 case HEAP_BY_INFOPTR:
682 fprint_data(hp_file);
684 case HEAP_BY_CLOSURE_TYPE:
685 fprint_closure_types(hp_file);
691 switch (RtsFlags.ProfFlags.doHeapProfile) {
693 reportCCSResid(hp_file,CCS_MAIN);
698 reportCtrResid(hp_file);
701 barf("heapCensus; doHeapProfile");
705 fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
708 #endif /* PROFILING || DEBUG_HEAP_PROF */