1 /* -----------------------------------------------------------------------------
2 * $Id: DebugProf.c,v 1.4 1999/01/15 17:57:05 simonm Exp $
4 * (c) The GHC Team 1998
6 * Simple Heap Profiling
8 * ---------------------------------------------------------------------------*/
12 #include "BlockAlloc.h"
13 #include "DebugProf.h"
18 #if defined(DEBUG) && ! defined(PROFILING)
20 char prof_filename[128];
23 static void clear_table_data(void);
24 static void fprint_data(FILE *fp);
26 /* -----------------------------------------------------------------------------
27 Hash table for symbols.
28 -------------------------------------------------------------------------- */
36 #define SYMBOL_HASH_SIZE 0x3fff
38 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
43 return ((W_)ptr)>>4 & 0x3fff;
51 for (i=0; i < SYMBOL_HASH_SIZE; i++) {
52 symbol_hash[i].ptr = NULL;
57 lookup_symbol(void *addr)
59 nat orig_bucket = hash(addr);
63 while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
64 if (symbol_hash[bucket].ptr == addr) {
69 if (bucket == SYMBOL_HASH_SIZE) {
71 while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
72 if (symbol_hash[bucket].ptr == addr) {
77 if (bucket == orig_bucket) {
78 barf("out of symbol table space");
82 symbol_hash[bucket].ptr = addr;
83 lookupGHCName(addr,&symbol_hash[bucket].name);
84 symbol_hash[bucket].data = 0;
89 clear_table_data(void)
93 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
94 symbol_hash[i].data = 0;
103 for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
104 if (symbol_hash[i].data) {
105 fprintf(fp, " %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
111 add_data(void *addr, nat data)
113 symbol_hash[lookup_symbol(addr)].data += data;
116 /* -----------------------------------------------------------------------------
117 Closure Type Profiling;
118 -------------------------------------------------------------------------- */
120 static nat closure_types[N_CLOSURE_TYPES];
122 static char *type_names[] = {
128 , "CONSTR_NOCAF_STATIC"
167 , "MUT_ARR_PTRS_FROZEN"
182 fprint_closure_types(FILE *fp)
186 for (i = 0; i < N_CLOSURE_TYPES; i++) {
187 if (closure_types[i]) {
188 fprintf(fp, " %s %d\n", type_names[i], closure_types[i]);
193 /* -----------------------------------------------------------------------------
195 -------------------------------------------------------------------------- */
200 if (! RtsFlags.ProfFlags.doHeapProfile) {
204 sprintf(prof_filename, "%.124s.hp", prog_argv[0]);
206 prof_file = fopen(prof_filename, "w");
207 if (prof_file == NULL) {
208 fprintf(stderr, "Can't open heap profiling log file %s\n",
213 fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
214 fprintf(prof_file, "DATE \"%s\"\n", time_str());
216 fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
217 fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
219 fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
220 fprintf(prof_file, "END_SAMPLE 0.00\n");
222 DEBUG_LoadSymbols(prog_argv[0]);
234 if (! RtsFlags.ProfFlags.doHeapProfile) {
238 seconds = usertime();
239 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
240 fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
245 heapCensus(bdescr *bd)
248 const StgInfoTable *info;
252 switch (RtsFlags.ProfFlags.doHeapProfile) {
253 case HEAP_BY_INFOPTR:
256 case HEAP_BY_CLOSURE_TYPE:
257 memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
263 /* usertime() isn't very accurate, since it includes garbage
264 * collection time. We really want elapsed_mutator_time or
268 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
272 while (p < bd->free) {
273 info = get_itbl((StgClosure *)p);
275 switch (info->type) {
277 size = bco_sizeW((StgBCO *)p);
284 case IND_OLDGEN_PERM:
292 case CONSTR_CHARLIKE:
294 case CONSTR_NOCAF_STATIC:
298 size = sizeW_fromITBL(info);
302 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
307 size = sizeofW(StgInd);
310 case AP_UPD: /* we can treat this as being the same as a PAP */
312 size = pap_sizeW((StgPAP *)p);
317 size = arr_words_sizeW(stgCast(StgArrWords*,p));
321 case MUT_ARR_PTRS_FROZEN:
322 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
326 size = tso_sizeW((StgTSO *)p);
332 switch (RtsFlags.ProfFlags.doHeapProfile) {
333 case HEAP_BY_INFOPTR:
334 add_data((void *)(*p), size * sizeof(W_));
336 case HEAP_BY_CLOSURE_TYPE:
337 closure_types[info->type] += size * sizeof(W_);
345 switch (RtsFlags.ProfFlags.doHeapProfile) {
346 case HEAP_BY_INFOPTR:
347 fprint_data(prof_file);
349 case HEAP_BY_CLOSURE_TYPE:
350 fprint_closure_types(prof_file);
354 fprintf(prof_file, "END_SAMPLE %0.2f\n", time);