1 /* -----------------------------------------------------------------------------
2 * $Id: DebugProf.c,v 1.3 1999/01/13 17:25:38 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"
166 , "MUT_ARR_PTRS_FROZEN"
181 fprint_closure_types(FILE *fp)
185 for (i = 0; i < N_CLOSURE_TYPES; i++) {
186 if (closure_types[i]) {
187 fprintf(fp, " %s %d\n", type_names[i], closure_types[i]);
192 /* -----------------------------------------------------------------------------
194 -------------------------------------------------------------------------- */
199 if (! RtsFlags.ProfFlags.doHeapProfile) {
203 sprintf(prof_filename, "%.124s.hp", prog_argv[0]);
205 prof_file = fopen(prof_filename, "w");
206 if (prof_file == NULL) {
207 fprintf(stderr, "Can't open heap profiling log file %s\n",
212 fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
213 fprintf(prof_file, "DATE \"%s\"\n", time_str());
215 fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
216 fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
218 fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
219 fprintf(prof_file, "END_SAMPLE 0.00\n");
221 DEBUG_LoadSymbols(prog_argv[0]);
233 if (! RtsFlags.ProfFlags.doHeapProfile) {
237 seconds = usertime();
238 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
239 fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
244 heapCensus(bdescr *bd)
247 const StgInfoTable *info;
251 switch (RtsFlags.ProfFlags.doHeapProfile) {
252 case HEAP_BY_INFOPTR:
255 case HEAP_BY_CLOSURE_TYPE:
256 memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
262 /* usertime() isn't very accurate, since it includes garbage
263 * collection time. We really want elapsed_mutator_time or
267 fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
271 while (p < bd->free) {
272 info = get_itbl((StgClosure *)p);
274 switch (info->type) {
276 size = bco_sizeW((StgBCO *)p);
283 case IND_OLDGEN_PERM:
290 case CONSTR_CHARLIKE:
292 case CONSTR_NOCAF_STATIC:
296 size = sizeW_fromITBL(info);
300 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
305 size = sizeofW(StgInd);
308 case AP_UPD: /* we can treat this as being the same as a PAP */
310 size = pap_sizeW((StgPAP *)p);
315 size = arr_words_sizeW(stgCast(StgArrWords*,p));
319 case MUT_ARR_PTRS_FROZEN:
320 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
324 size = tso_sizeW((StgTSO *)p);
330 switch (RtsFlags.ProfFlags.doHeapProfile) {
331 case HEAP_BY_INFOPTR:
332 add_data((void *)(*p), size * sizeof(W_));
334 case HEAP_BY_CLOSURE_TYPE:
335 closure_types[info->type] += size * sizeof(W_);
343 switch (RtsFlags.ProfFlags.doHeapProfile) {
344 case HEAP_BY_INFOPTR:
345 fprint_data(prof_file);
347 case HEAP_BY_CLOSURE_TYPE:
348 fprint_closure_types(prof_file);
352 fprintf(prof_file, "END_SAMPLE %0.2f\n", time);