ghc/rts/DebugProf.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: DebugProf.c,v 1.5 1999/02/05 15:25:04 simonm Exp $
   3  *
   4  * (c) The GHC Team 1998
   5  *
   6  * Simple Heap Profiling
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "Printer.h"
  12 #include "BlockAlloc.h"
  13 #include "DebugProf.h"
  14 #include "RtsFlags.h"
  15 #include "RtsUtils.h"
  16 #include "Stats.h"
  17
  18 #if defined(DEBUG) && ! defined(PROFILING)
  19
  20 char prof_filename[128];
  21 FILE *prof_file;
  22
  23 static void clear_table_data(void);
  24 static void fprint_data(FILE *fp);
  25
  26 /* -----------------------------------------------------------------------------
  27    Hash table for symbols.
  28    -------------------------------------------------------------------------- */
  29
  30 typedef struct {
  31     const char *name;
  32     void *ptr;
  33     nat data;
  34 } symbol_info;
  35
  36 #define SYMBOL_HASH_SIZE 0x3fff
  37
  38 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
  39
  40 static inline nat
  41 hash(void *ptr)
  42 {
  43     return ((W_)ptr)>>4 & 0x3fff;
  44 }
  45
  46 static void
  47 initSymbolHash(void)
  48 {
  49     nat i;
  50
  51     for (i=0; i < SYMBOL_HASH_SIZE; i++) {
  52         symbol_hash[i].ptr = NULL;
  53     }
  54 }
  55
  56 static nat
  57 lookup_symbol(void *addr)
  58 {
  59     nat orig_bucket = hash(addr);
  60     nat bucket;
  61
  62     bucket = orig_bucket;
  63     while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
  64         if (symbol_hash[bucket].ptr == addr) {
  65             return bucket;
  66         }
  67         bucket++;
  68     }
  69     if (bucket == SYMBOL_HASH_SIZE) {
  70         bucket = 0;
  71         while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
  72             if (symbol_hash[bucket].ptr == addr) {
  73                 return bucket;
  74             }
  75             bucket++;
  76         }
  77         if (bucket == orig_bucket) {
  78             barf("out of symbol table space");
  79         }
  80     }
  81
  82     symbol_hash[bucket].ptr  = addr;
  83     lookupGHCName(addr,&symbol_hash[bucket].name);
  84     symbol_hash[bucket].data = 0;
  85     return bucket;
  86 }
  87
  88 static void
  89 clear_table_data(void)
  90 {
  91     nat i;
  92
  93     for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
  94         symbol_hash[i].data = 0;
  95     }
  96 }
  97
  98 static void
  99 fprint_data(FILE *fp)
 100 {
 101     nat i;
 102
 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);
 106         }
 107     }
 108 }
 109
 110 static inline void
 111 add_data(void *addr, nat data)
 112 {
 113     symbol_hash[lookup_symbol(addr)].data += data;
 114 }
 115
 116 /* -----------------------------------------------------------------------------
 117    Closure Type Profiling;
 118    -------------------------------------------------------------------------- */
 119
 120 static nat closure_types[N_CLOSURE_TYPES];
 121
 122 static char *type_names[] = {
 123       "INVALID_OBJECT"
 124     , "CONSTR"
 125     , "CONSTR_INTLIKE"
 126     , "CONSTR_CHARLIKE"
 127     , "CONSTR_STATIC"
 128     , "CONSTR_NOCAF_STATIC"
 129
 130     , "FUN"
 131     , "FUN_STATIC"
 132
 133     , "THUNK"
 134     , "THUNK_STATIC"
 135     , "THUNK_SELECTOR"
 136
 137     , "BCO"
 138     , "AP_UPD"
 139
 140     , "PAP"
 141
 142     , "IND"
 143     , "IND_OLDGEN"
 144     , "IND_PERM"
 145     , "IND_OLDGEN_PERM"
 146     , "IND_STATIC"
 147
 148     , "RET_BCO"
 149     , "RET_SMALL"
 150     , "RET_VEC_SMALL"
 151     , "RET_BIG"
 152     , "RET_VEC_BIG"
 153     , "RET_DYN"
 154     , "UPDATE_FRAME"
 155     , "CATCH_FRAME"
 156     , "STOP_FRAME"
 157     , "SEQ_FRAME"
 158
 159     , "BLACKHOLE"
 160     , "BLACKHOLE_BQ"
 161     , "MVAR"
 162
 163     , "ARR_WORDS"
 164
 165     , "MUT_ARR_PTRS"
 166     , "MUT_ARR_PTRS_FROZEN"
 167     , "MUT_VAR"
 168
 169     , "WEAK"
 170     , "FOREIGN"
 171
 172     , "TSO"
 173
 174     , "BLOCKED_FETCH"
 175     , "FETCH_ME"
 176
 177     , "EVACUATED"
 178 };
 179
 180 static void
 181 fprint_closure_types(FILE *fp)
 182 {
 183   nat i;
 184
 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]);
 188     }
 189   }
 190 }
 191
 192 /* -----------------------------------------------------------------------------
 193    The profiler itself
 194    -------------------------------------------------------------------------- */
 195
 196 nat
 197 initProfiling(void)
 198 {
 199     if (! RtsFlags.ProfFlags.doHeapProfile) {
 200         return 0;
 201     }
 202
 203     sprintf(prof_filename, "%.124s.hp", prog_argv[0]);
 204
 205     prof_file = fopen(prof_filename, "w");
 206     if (prof_file == NULL) {
 207         fprintf(stderr, "Can't open heap profiling log file %s\n",
 208                 prof_filename);
 209         return 1;
 210     }
 211
 212     fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
 213     fprintf(prof_file, "DATE \"%s\"\n", time_str());
 214
 215     fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
 216     fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
 217
 218     fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
 219     fprintf(prof_file, "END_SAMPLE 0.00\n");
 220
 221     DEBUG_LoadSymbols(prog_argv[0]);
 222
 223     initSymbolHash();
 224
 225     return 0;
 226 }
 227
 228 void
 229 endProfiling(void)
 230 {
 231     StgDouble seconds;
 232
 233     if (! RtsFlags.ProfFlags.doHeapProfile) {
 234         return;
 235     }
 236
 237     seconds = usertime();
 238     fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 239     fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
 240     fclose(prof_file);
 241 }
 242
 243 void
 244 heapCensus(bdescr *bd)
 245 {
 246     StgPtr p;
 247     const StgInfoTable *info;
 248     StgDouble time;
 249     nat size;
 250
 251     switch (RtsFlags.ProfFlags.doHeapProfile) {
 252     case HEAP_BY_INFOPTR:
 253       clear_table_data();
 254       break;
 255     case HEAP_BY_CLOSURE_TYPE:
 256       memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
 257       break;
 258     default:
 259       return;
 260     }
 261
 262     /* usertime() isn't very accurate, since it includes garbage
 263      * collection time.  We really want elapsed_mutator_time or
 264      * something.  ToDo.
 265      */
 266     time = usertime();
 267     fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
 268
 269     while (bd != NULL) {
 270         p = bd->start;
 271         while (p < bd->free) {
 272             info = get_itbl((StgClosure *)p);
 273
 274             switch (info->type) {
 275             case BCO:
 276                 size = bco_sizeW((StgBCO *)p);
 277                 break;
 278
 279             case FUN:
 280             case THUNK:
 281             case CONSTR:
 282             case IND_PERM:
 283             case IND_OLDGEN_PERM:
 284             case BLACKHOLE:
 285             case BLACKHOLE_BQ:
 286             case WEAK:
 287             case FOREIGN:
 288             case MVAR:
 289             case MUT_VAR:
 290             case CONSTR_INTLIKE:
 291             case CONSTR_CHARLIKE:
 292             case CONSTR_STATIC:
 293             case CONSTR_NOCAF_STATIC:
 294             case THUNK_STATIC:
 295             case FUN_STATIC:
 296             case IND_STATIC:
 297                 size = sizeW_fromITBL(info);
 298                 break;
 299
 300             case THUNK_SELECTOR:
 301                 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 302                 break;
 303
 304             case IND:
 305             case IND_OLDGEN:
 306                 size = sizeofW(StgInd);
 307                 break;
 308
 309             case AP_UPD: /* we can treat this as being the same as a PAP */
 310             case PAP:
 311                 size = pap_sizeW((StgPAP *)p);
 312                 break;
 313
 314             case ARR_WORDS:
 315                 size = arr_words_sizeW(stgCast(StgArrWords*,p));
 316                 break;
 317
 318             case MUT_ARR_PTRS:
 319             case MUT_ARR_PTRS_FROZEN:
 320                 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 321                 break;
 322
 323             case TSO:
 324                 size = tso_sizeW((StgTSO *)p);
 325                 break;
 326
 327             default:
 328                 barf("heapCensus");
 329             }
 330             switch (RtsFlags.ProfFlags.doHeapProfile) {
 331             case HEAP_BY_INFOPTR:
 332               add_data((void *)(*p), size * sizeof(W_));
 333               break;
 334             case HEAP_BY_CLOSURE_TYPE:
 335               closure_types[info->type] += size * sizeof(W_);
 336               break;
 337             }
 338             p += size;
 339         }
 340         bd = bd->link;
 341     }
 342
 343     switch (RtsFlags.ProfFlags.doHeapProfile) {
 344     case HEAP_BY_INFOPTR:
 345       fprint_data(prof_file);
 346       break;
 347     case HEAP_BY_CLOSURE_TYPE:
 348       fprint_closure_types(prof_file);
 349       break;
 350     }
 351
 352     fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
 353 }
 354
 355 #endif
 356