1 /* -----------------------------------------------------------------------------
2 * $Id: ProfHeap.c,v 1.2 1999/09/16 12:29:55 simonmar Exp $
4 * (c) The GHC Team, 1998-1999
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)
26 #ifdef DEBUG_HEAP_PROF
28 static void initSymbolHash(void);
29 static void clear_table_data(void);
30 static void fprint_data(FILE *fp);
33 char prof_filename[128]; /* urk */
36 #ifdef DEBUG_HEAP_PROF
37 void initProfiling( void )
42 void endProfiling( void )
46 #endif /* DEBUG_HEAP_PROF */
49 initHeapProfiling(void)
51 if (! RtsFlags.ProfFlags.doHeapProfile) {
55 sprintf(prof_filename, "%.124s.hp", prog_argv[0]);
57 prof_file = fopen(prof_filename, "w");
58 if (prof_file == NULL) {
59 fprintf(stderr, "Can't open heap profiling log file %s\n",
64 fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
65 fprintf(prof_file, "DATE \"%s\"\n", time_str());
67 fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
68 fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
70 fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
71 fprintf(prof_file, "END_SAMPLE 0.00\n");
73 #ifdef DEBUG_HEAP_PROF
74 DEBUG_LoadSymbols(prog_argv[0]);
82 endHeapProfiling(void)
86 if (! RtsFlags.ProfFlags.doHeapProfile) {
90 seconds = mut_user_time();
91 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
92 fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
96 #ifdef DEBUG_HEAP_PROF
97 /* -----------------------------------------------------------------------------
98 Hash table for symbols.
99 -------------------------------------------------------------------------- */
107 #define SYMBOL_HASH_SIZE 0x3fff
109 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
114 return ((W_)ptr)>>4 & 0x3fff;
122 for (i=0; i < SYMBOL_HASH_SIZE; i++) {
123 symbol_hash[i].ptr = NULL;
128 lookup_symbol(void *addr)
130 nat orig_bucket = hash(addr);
133 bucket = orig_bucket;
134 while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
135 if (symbol_hash[bucket].ptr == addr) {
140 if (bucket == SYMBOL_HASH_SIZE) {
142 while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
143 if (symbol_hash[bucket].ptr == addr) {
148 if (bucket == orig_bucket) {
149 barf("out of symbol table space");
153 symbol_hash[bucket].ptr = addr;
154 lookupGHCName(addr,&symbol_hash[bucket].name);
155 symbol_hash[bucket].data = 0;
160 clear_table_data(void)
164 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
165 symbol_hash[i].data = 0;
170 fprint_data(FILE *fp)
174 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
175 if (symbol_hash[i].data) {
176 fprintf(fp, " %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
182 add_data(void *addr, nat data)
184 symbol_hash[lookup_symbol(addr)].data += data;
187 /* -----------------------------------------------------------------------------
188 Closure Type Profiling;
190 PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
191 -------------------------------------------------------------------------- */
193 static nat closure_types[N_CLOSURE_TYPES];
195 static char *type_names[] = {
201 , "CONSTR_NOCAF_STATIC"
239 , "MUT_ARR_PTRS_FROZEN"
254 fprint_closure_types(FILE *fp)
258 for (i = 0; i < N_CLOSURE_TYPES; i++) {
259 if (closure_types[i]) {
260 fprintf(fp, " %s %d\n", type_names[i], closure_types[i]);
265 #endif /* DEBUG_HEAP_PROF */
270 clearCCSResid(CostCentreStack *ccs)
276 for (i = ccs->indexTable; i != 0; i = i->next) {
277 clearCCSResid(i->ccs);
282 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
285 CostCentreStack *prev;
288 prev = ccs->prevStack;
291 || prev->cc->is_subsumed != CC_IS_BORING
292 || components == 1) {
293 fprintf(fp,"%s",cc->label);
297 fprint_ccs(fp, ccs->prevStack,components-1);
298 fprintf(fp,"/%s",cc->label);
303 reportCCSResid(FILE *fp, CostCentreStack *ccs)
307 if (ccs->mem_resid != 0) {
309 fprint_ccs(fp,ccs,2/*print 2 components only*/);
310 fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
313 for (i = ccs->indexTable; i != 0; i = i->next) {
314 reportCCSResid(fp,i->ccs);
323 const StgInfoTable *info;
328 #ifdef DEBUG_HEAP_PROF
329 switch (RtsFlags.ProfFlags.doHeapProfile) {
330 case HEAP_BY_INFOPTR:
333 case HEAP_BY_CLOSURE_TYPE:
334 memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
342 switch (RtsFlags.ProfFlags.doHeapProfile) {
343 case NO_HEAP_PROFILING:
348 barf("heapCensus; doHeapProfile");
350 /* zero all the residency counters */
351 clearCCSResid(CCS_MAIN);
354 /* Only do heap profiling in a two-space heap */
355 ASSERT(RtsFlags.GcFlags.generations == 1);
358 time = mut_user_time_during_GC();
359 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
363 while (p < bd->free) {
364 info = get_itbl((StgClosure *)p);
366 switch (info->type) {
368 size = bco_sizeW((StgBCO *)p);
372 if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
373 size = sizeofW(StgWeak);
376 /* else, fall through... */
381 case IND_OLDGEN_PERM:
383 case SE_CAF_BLACKHOLE:
393 case CONSTR_CHARLIKE:
409 size = sizeW_fromITBL(info);
413 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
416 case AP_UPD: /* we can treat this as being the same as a PAP */
418 size = pap_sizeW((StgPAP *)p);
422 size = arr_words_sizeW(stgCast(StgArrWords*,p));
426 case MUT_ARR_PTRS_FROZEN:
427 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
431 size = tso_sizeW((StgTSO *)p);
438 #ifdef DEBUG_HEAP_PROF
439 switch (RtsFlags.ProfFlags.doHeapProfile) {
440 case HEAP_BY_INFOPTR:
441 add_data((void *)(*p), size * sizeof(W_));
443 case HEAP_BY_CLOSURE_TYPE:
444 closure_types[info->type] += size * sizeof(W_);
450 ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
457 #ifdef DEBUG_HEAP_PROF
458 switch (RtsFlags.ProfFlags.doHeapProfile) {
459 case HEAP_BY_INFOPTR:
460 fprint_data(prof_file);
462 case HEAP_BY_CLOSURE_TYPE:
463 fprint_closure_types(prof_file);
469 reportCCSResid(prof_file,CCS_MAIN);
472 fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
475 #endif /* PROFILING || DEBUG_HEAP_PROF */