[project @ 2000-03-23 13:13:29 by simonmar]
[ghc-hetmet.git] / ghc / rts / ProfHeap.c
1 /* -----------------------------------------------------------------------------
2  * $Id: ProfHeap.c,v 1.7 2000/03/23 13:13:29 simonmar Exp $
3  *
4  * (c) The GHC Team, 1998-2000
5  *
6  * Support for heap profiling
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #if defined(DEBUG) && !defined(PROFILING)
11 #define DEBUG_HEAP_PROF
12 #else
13 #undef DEBUG_HEAP_PROF
14 #endif
15
16 #if defined(PROFILING) || defined(DEBUG_HEAP_PROF)
17
18 #include "Rts.h"
19 #include "RtsUtils.h"
20 #include "RtsFlags.h"
21 #include "ProfRts.h"
22 #include "Storage.h"
23 #include "ProfHeap.h"
24 #include "Stats.h"
25 #include "ProfRts.h"
26 #ifdef DEBUG_HEAP_PROF
27 #include "Printer.h"
28 static void initSymbolHash(void);
29 static void clear_table_data(void);
30 static void fprint_data(FILE *fp);
31 #endif
32
33 char prof_filename[128];        /* urk */
34
35 #ifdef DEBUG_HEAP_PROF
36 FILE *prof_file;
37
38 void initProfiling1( void )
39 {
40 }
41
42 void initProfiling2( void )
43 {
44   initHeapProfiling();
45 }
46
47 void endProfiling( void )
48 {
49   endHeapProfiling();
50 }
51 #endif /* DEBUG_HEAP_PROF */
52
53 nat
54 initHeapProfiling(void)
55 {
56     if (! RtsFlags.ProfFlags.doHeapProfile) {
57         return 0;
58     }
59
60     fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
61     fprintf(prof_file, "DATE \"%s\"\n", time_str());
62
63     fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
64     fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
65
66     fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
67     fprintf(prof_file, "END_SAMPLE 0.00\n");
68
69 #ifdef DEBUG_HEAP_PROF
70     DEBUG_LoadSymbols(prog_argv[0]);
71     initSymbolHash();
72 #endif
73
74     return 0;
75 }
76
77 void
78 endHeapProfiling(void)
79 {
80     StgDouble seconds;
81
82     if (! RtsFlags.ProfFlags.doHeapProfile) {
83         return;
84     }
85
86     seconds = mut_user_time();
87     fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
88     fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
89     fclose(prof_file);
90 }
91
92 #ifdef DEBUG_HEAP_PROF
93 /* -----------------------------------------------------------------------------
94    Hash table for symbols.
95    -------------------------------------------------------------------------- */
96
97 typedef struct {
98     const char *name;
99     void *ptr;
100     nat data;
101 } symbol_info;
102
103 #define SYMBOL_HASH_SIZE 0x3fff
104
105 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
106
107 static inline nat
108 hash(void *ptr)
109 {
110     return ((W_)ptr)>>4 & 0x3fff;
111 }
112
113 static void
114 initSymbolHash(void)
115 {
116     nat i;
117
118     for (i=0; i < SYMBOL_HASH_SIZE; i++) {
119         symbol_hash[i].ptr = NULL;
120     }
121 }
122
123 static nat
124 lookup_symbol(void *addr)
125 {
126     nat orig_bucket = hash(addr);
127     nat bucket;
128
129     bucket = orig_bucket;
130     while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
131         if (symbol_hash[bucket].ptr == addr) {
132             return bucket;
133         }
134         bucket++;
135     }
136     if (bucket == SYMBOL_HASH_SIZE) {
137         bucket = 0;
138         while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
139             if (symbol_hash[bucket].ptr == addr) {
140                 return bucket;
141             }
142             bucket++;
143         }
144         if (bucket == orig_bucket) {
145             barf("out of symbol table space");
146         }
147     }
148     
149     symbol_hash[bucket].ptr  = addr;
150     lookupGHCName(addr,&symbol_hash[bucket].name);
151     symbol_hash[bucket].data = 0;
152     return bucket;
153 }
154
155 static void
156 clear_table_data(void)
157 {
158     nat i;
159
160     for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
161         symbol_hash[i].data = 0;
162     }
163 }
164
165 static void
166 fprint_data(FILE *fp)
167 {
168     nat i;
169     
170     for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
171         if (symbol_hash[i].data) {
172             fprintf(fp, "   %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
173         }
174     }
175 }
176
177 static inline void
178 add_data(void *addr, nat data)
179 {
180     symbol_hash[lookup_symbol(addr)].data += data;
181 }
182
183 /* -----------------------------------------------------------------------------
184    Closure Type Profiling;
185
186    PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
187    -------------------------------------------------------------------------- */
188
189 static nat closure_types[N_CLOSURE_TYPES];
190
191 static char *type_names[] = {
192       "INVALID_OBJECT"
193     , "CONSTR"
194     , "CONSTR_INTLIKE"
195     , "CONSTR_CHARLIKE"
196     , "CONSTR_STATIC"
197     , "CONSTR_NOCAF_STATIC"
198
199     , "FUN"
200     , "FUN_STATIC"
201
202     , "THUNK"
203     , "THUNK_STATIC"
204     , "THUNK_SELECTOR"
205
206     , "BCO"
207     , "AP_UPD"
208
209     , "PAP"
210
211     , "IND"
212     , "IND_OLDGEN"
213     , "IND_PERM"
214     , "IND_OLDGEN_PERM"
215     , "IND_STATIC"
216
217     , "RET_BCO"
218     , "RET_SMALL"
219     , "RET_VEC_SMALL"
220     , "RET_BIG"
221     , "RET_VEC_BIG"
222     , "RET_DYN"
223     , "UPDATE_FRAME"
224     , "CATCH_FRAME"
225     , "STOP_FRAME"
226     , "SEQ_FRAME"
227
228     , "BLACKHOLE"
229     , "BLACKHOLE_BQ"
230     , "MVAR"
231
232     , "ARR_WORDS"
233
234     , "MUT_ARR_PTRS"
235     , "MUT_ARR_PTRS_FROZEN"
236     , "MUT_VAR"
237
238     , "WEAK"
239     , "FOREIGN"
240   
241     , "TSO"
242
243     , "BLOCKED_FETCH"
244     , "FETCH_ME"
245
246     , "EVACUATED"
247 };
248
249 static void 
250 fprint_closure_types(FILE *fp)
251 {
252   nat i;
253
254   for (i = 0; i < N_CLOSURE_TYPES; i++) {
255     if (closure_types[i]) {
256       fprintf(fp, "   %s %d\n", type_names[i], closure_types[i]);
257     }
258   }
259 }
260
261 #endif /* DEBUG_HEAP_PROF */
262
263
264 #ifdef PROFILING
265 static void
266 clearCCSResid(CostCentreStack *ccs)
267 {
268   IndexTable *i;
269
270   ccs->mem_resid = 0;
271
272   for (i = ccs->indexTable; i != 0; i = i->next) {
273     if (!i->back_edge) {
274       clearCCSResid(i->ccs);
275     }
276   }
277 }
278
279 static void
280 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
281 {
282   CostCentre *cc;
283   CostCentreStack *prev;
284
285   cc = ccs->cc;
286   prev = ccs->prevStack;
287
288   if (prev == NULL
289       || prev->cc->is_subsumed != CC_IS_BORING
290       || components == 1) { 
291     fprintf(fp,"%s",cc->label);
292     return; 
293
294   } else {
295     fprint_ccs(fp, ccs->prevStack,components-1);
296     fprintf(fp,"/%s",cc->label);
297   }
298 }
299
300 static void
301 reportCCSResid(FILE *fp, CostCentreStack *ccs)
302 {
303   IndexTable *i;
304
305   if (ccs->mem_resid != 0) {
306     fprintf(fp,"   ");
307     fprint_ccs(fp,ccs,2/*print 2 components only*/);
308     fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
309   }
310
311   for (i = ccs->indexTable; i != 0; i = i->next) {
312     if (!i->back_edge) {
313       reportCCSResid(fp,i->ccs);
314     }
315   }
316 }
317 #endif
318
319 void
320 heapCensus(void)
321 {
322   bdescr *bd;
323   const StgInfoTable *info;
324   StgDouble time;
325   nat size;
326   StgPtr p;
327   
328 #ifdef DEBUG_HEAP_PROF
329   switch (RtsFlags.ProfFlags.doHeapProfile) {
330   case HEAP_BY_INFOPTR:
331     clear_table_data();
332     break;
333   case HEAP_BY_CLOSURE_TYPE:
334     memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
335     break;
336   default:
337     return;
338   }
339 #endif
340
341 #ifdef PROFILING
342   switch (RtsFlags.ProfFlags.doHeapProfile) {
343   case NO_HEAP_PROFILING:
344     return;
345   case HEAP_BY_CCS:
346     break;
347   default:
348     barf("heapCensus; doHeapProfile");
349   }
350   /* zero all the residency counters */
351   clearCCSResid(CCS_MAIN);
352 #endif
353
354   /* Only do heap profiling in a two-space heap */
355   ASSERT(RtsFlags.GcFlags.generations == 1);
356   bd = g0s0->to_space;
357
358   time = mut_user_time_during_GC();
359   fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
360   
361   while (bd != NULL) {
362     p = bd->start;
363     while (p < bd->free) {
364       info = get_itbl((StgClosure *)p);
365
366       switch (info->type) {
367       case BCO:
368         size = bco_sizeW((StgBCO *)p);
369         break;
370         
371       case CONSTR:
372         if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
373           size = sizeofW(StgWeak);
374           break;
375         }
376         /* else, fall through... */
377
378       case FUN:
379       case THUNK:
380       case IND_PERM:
381       case IND_OLDGEN_PERM:
382       case CAF_BLACKHOLE:
383       case SE_CAF_BLACKHOLE:
384       case SE_BLACKHOLE:
385       case BLACKHOLE:
386       case BLACKHOLE_BQ:
387       case WEAK:
388       case FOREIGN:
389       case STABLE_NAME:
390       case MVAR:
391       case MUT_VAR:
392       case CONSTR_INTLIKE:
393       case CONSTR_CHARLIKE:
394       case FUN_1_0:
395       case FUN_0_1:
396       case FUN_1_1:
397       case FUN_0_2:
398       case FUN_2_0:
399       case THUNK_1_0:
400       case THUNK_0_1:
401       case THUNK_1_1:
402       case THUNK_0_2:
403       case THUNK_2_0:
404       case CONSTR_1_0:
405       case CONSTR_0_1:
406       case CONSTR_1_1:
407       case CONSTR_0_2:
408       case CONSTR_2_0:
409         size = sizeW_fromITBL(info);
410         break;
411         
412       case THUNK_SELECTOR:
413         size = sizeofW(StgHeader) + MIN_UPD_SIZE;
414         break;
415         
416       case AP_UPD: /* we can treat this as being the same as a PAP */
417       case PAP:
418         size = pap_sizeW((StgPAP *)p);
419         break;
420         
421       case ARR_WORDS:
422         size = arr_words_sizeW(stgCast(StgArrWords*,p));
423         break;
424         
425       case MUT_ARR_PTRS:
426       case MUT_ARR_PTRS_FROZEN:
427         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
428         break;
429         
430       case TSO:
431         size = tso_sizeW((StgTSO *)p);
432         break;
433         
434       default:
435         barf("heapCensus");
436       }
437
438 #ifdef DEBUG_HEAP_PROF
439       switch (RtsFlags.ProfFlags.doHeapProfile) {
440       case HEAP_BY_INFOPTR:
441         add_data((void *)(*p), size * sizeof(W_));
442         break;
443       case HEAP_BY_CLOSURE_TYPE:
444         closure_types[info->type] += size * sizeof(W_);
445         break;
446       }
447 #endif
448
449 #ifdef PROFILING      
450       ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
451 #endif
452       p += size;
453     }
454     bd = bd->link;
455   }
456
457 #ifdef DEBUG_HEAP_PROF
458   switch (RtsFlags.ProfFlags.doHeapProfile) {
459   case HEAP_BY_INFOPTR:
460     fprint_data(prof_file);
461     break;
462   case HEAP_BY_CLOSURE_TYPE:
463     fprint_closure_types(prof_file);
464     break;
465   }
466 #endif
467     
468 #ifdef PROFILING
469   reportCCSResid(prof_file,CCS_MAIN);
470 #endif
471
472   fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
473 }    
474
475 #endif /* PROFILING || DEBUG_HEAP_PROF */
476