1 /* -----------------------------------------------------------------------------
2 * $Id: ProfHeap.c,v 1.10 2000/04/03 15:54:49 simonmar 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"
25 #ifdef DEBUG_HEAP_PROF
27 static void initSymbolHash(void);
28 static void clear_table_data(void);
29 static void fprint_data(FILE *fp);
32 char prof_filename[128]; /* urk */
34 #ifdef DEBUG_HEAP_PROF
37 void initProfiling1( void )
41 void initProfiling2( void )
46 void endProfiling( void )
50 #endif /* DEBUG_HEAP_PROF */
53 initHeapProfiling(void)
55 if (! RtsFlags.ProfFlags.doHeapProfile) {
59 fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
60 fprintf(prof_file, "DATE \"%s\"\n", time_str());
62 fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
63 fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
65 fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
66 fprintf(prof_file, "END_SAMPLE 0.00\n");
68 #ifdef DEBUG_HEAP_PROF
69 DEBUG_LoadSymbols(prog_argv[0]);
77 endHeapProfiling(void)
81 if (! RtsFlags.ProfFlags.doHeapProfile) {
85 seconds = mut_user_time();
86 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
87 fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
91 #ifdef DEBUG_HEAP_PROF
92 /* -----------------------------------------------------------------------------
93 Hash table for symbols.
94 -------------------------------------------------------------------------- */
102 #define SYMBOL_HASH_SIZE 0x3fff
104 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
109 return ((W_)ptr)>>4 & 0x3fff;
117 for (i=0; i < SYMBOL_HASH_SIZE; i++) {
118 symbol_hash[i].ptr = NULL;
123 lookup_symbol(void *addr)
125 nat orig_bucket = hash(addr);
128 bucket = orig_bucket;
129 while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
130 if (symbol_hash[bucket].ptr == addr) {
135 if (bucket == SYMBOL_HASH_SIZE) {
137 while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
138 if (symbol_hash[bucket].ptr == addr) {
143 if (bucket == orig_bucket) {
144 barf("out of symbol table space");
148 symbol_hash[bucket].ptr = addr;
149 lookupGHCName(addr,&symbol_hash[bucket].name);
150 symbol_hash[bucket].data = 0;
155 clear_table_data(void)
159 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
160 symbol_hash[i].data = 0;
165 fprint_data(FILE *fp)
169 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
170 if (symbol_hash[i].data) {
171 fprintf(fp, " %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
177 add_data(void *addr, nat data)
179 symbol_hash[lookup_symbol(addr)].data += data;
182 /* -----------------------------------------------------------------------------
183 Closure Type Profiling;
185 PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
186 -------------------------------------------------------------------------- */
188 static nat closure_types[N_CLOSURE_TYPES];
190 static char *type_names[] = {
196 , "CONSTR_NOCAF_STATIC"
234 , "MUT_ARR_PTRS_FROZEN"
249 fprint_closure_types(FILE *fp)
253 for (i = 0; i < N_CLOSURE_TYPES; i++) {
254 if (closure_types[i]) {
255 fprintf(fp, " %s %d\n", type_names[i], closure_types[i]);
260 #endif /* DEBUG_HEAP_PROF */
265 clearCCSResid(CostCentreStack *ccs)
271 for (i = ccs->indexTable; i != 0; i = i->next) {
273 clearCCSResid(i->ccs);
279 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
282 CostCentreStack *prev;
285 prev = ccs->prevStack;
288 || prev->cc->is_caf != CC_IS_BORING
289 || components == 1) {
290 fprintf(fp,"%s",cc->label);
294 fprint_ccs(fp, ccs->prevStack,components-1);
295 fprintf(fp,"/%s",cc->label);
300 reportCCSResid(FILE *fp, CostCentreStack *ccs)
304 if (ccs->mem_resid != 0) {
306 fprint_ccs(fp,ccs,2/*print 2 components only*/);
307 fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
310 for (i = ccs->indexTable; i != 0; i = i->next) {
312 reportCCSResid(fp,i->ccs);
322 const StgInfoTable *info;
327 #ifdef DEBUG_HEAP_PROF
328 switch (RtsFlags.ProfFlags.doHeapProfile) {
329 case HEAP_BY_INFOPTR:
332 case HEAP_BY_CLOSURE_TYPE:
335 memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
344 switch (RtsFlags.ProfFlags.doHeapProfile) {
345 case NO_HEAP_PROFILING:
350 barf("heapCensus; doHeapProfile");
352 /* zero all the residency counters */
353 clearCCSResid(CCS_MAIN);
356 /* Only do heap profiling in a two-space heap */
357 ASSERT(RtsFlags.GcFlags.generations == 1);
360 time = mut_user_time_during_GC();
361 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
365 while (p < bd->free) {
366 info = get_itbl((StgClosure *)p);
368 switch (info->type) {
370 size = bco_sizeW((StgBCO *)p);
374 if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
375 size = sizeofW(StgWeak);
378 /* else, fall through... */
383 case IND_OLDGEN_PERM:
385 case SE_CAF_BLACKHOLE:
395 case CONSTR_CHARLIKE:
409 size = sizeW_fromITBL(info);
412 case THUNK_1_0: /* ToDo - shouldn't be here */
413 case THUNK_0_1: /* " ditto " */
415 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
418 case AP_UPD: /* we can treat this as being the same as a PAP */
420 size = pap_sizeW((StgPAP *)p);
424 size = arr_words_sizeW(stgCast(StgArrWords*,p));
428 case MUT_ARR_PTRS_FROZEN:
429 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
433 size = tso_sizeW((StgTSO *)p);
440 #ifdef DEBUG_HEAP_PROF
441 switch (RtsFlags.ProfFlags.doHeapProfile) {
442 case HEAP_BY_INFOPTR:
443 add_data((void *)(*p), size * sizeof(W_));
445 case HEAP_BY_CLOSURE_TYPE:
446 closure_types[info->type] += size * sizeof(W_);
452 ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
459 #ifdef DEBUG_HEAP_PROF
460 switch (RtsFlags.ProfFlags.doHeapProfile) {
461 case HEAP_BY_INFOPTR:
462 fprint_data(prof_file);
464 case HEAP_BY_CLOSURE_TYPE:
465 fprint_closure_types(prof_file);
471 reportCCSResid(prof_file,CCS_MAIN);
474 fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
477 #endif /* PROFILING || DEBUG_HEAP_PROF */