ghc/rts/DebugProf.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: DebugProf.c,v 1.2 1998/12/02 13:28:14 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     , "MVAR"
 161
 162     , "ARR_WORDS"
 163     , "ARR_PTRS"
 164
 165     , "MUT_ARR_WORDS"
 166     , "MUT_ARR_PTRS"
 167     , "MUT_ARR_PTRS_FROZEN"
 168     , "MUT_VAR"
 169
 170     , "WEAK"
 171     , "FOREIGN"
 172
 173     , "TSO"
 174
 175     , "BLOCKED_FETCH"
 176     , "FETCH_ME"
 177
 178     , "EVACUATED"
 179 };
 180
 181 static void
 182 fprint_closure_types(FILE *fp)
 183 {
 184   nat i;
 185
 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]);
 189     }
 190   }
 191 }
 192
 193 /* -----------------------------------------------------------------------------
 194    The profiler itself
 195    -------------------------------------------------------------------------- */
 196
 197 nat
 198 initProfiling(void)
 199 {
 200     if (! RtsFlags.ProfFlags.doHeapProfile) {
 201         return 0;
 202     }
 203
 204     sprintf(prof_filename, "%.124s.hp", prog_argv[0]);
 205
 206     prof_file = fopen(prof_filename, "w");
 207     if (prof_file == NULL) {
 208         fprintf(stderr, "Can't open heap profiling log file %s\n",
 209                 prof_filename);
 210         return 1;
 211     }
 212
 213     fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
 214     fprintf(prof_file, "DATE \"%s\"\n", time_str());
 215
 216     fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
 217     fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
 218
 219     fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
 220     fprintf(prof_file, "END_SAMPLE 0.00\n");
 221
 222     DEBUG_LoadSymbols(prog_argv[0]);
 223
 224     initSymbolHash();
 225
 226     return 0;
 227 }
 228
 229 void
 230 endProfiling(void)
 231 {
 232     StgDouble seconds;
 233
 234     if (! RtsFlags.ProfFlags.doHeapProfile) {
 235         return;
 236     }
 237
 238     seconds = usertime();
 239     fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 240     fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
 241     fclose(prof_file);
 242 }
 243
 244 void
 245 heapCensus(bdescr *bd)
 246 {
 247     StgPtr p;
 248     const StgInfoTable *info;
 249     StgDouble time;
 250     nat size;
 251
 252     switch (RtsFlags.ProfFlags.doHeapProfile) {
 253     case HEAP_BY_INFOPTR:
 254       clear_table_data();
 255       break;
 256     case HEAP_BY_CLOSURE_TYPE:
 257       memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
 258       break;
 259     default:
 260       return;
 261     }
 262
 263     /* usertime() isn't very accurate, since it includes garbage
 264      * collection time.  We really want elapsed_mutator_time or
 265      * something.  ToDo.
 266      */
 267     time = usertime();
 268     fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
 269
 270     while (bd != NULL) {
 271         p = bd->start;
 272         while (p < bd->free) {
 273             info = get_itbl((StgClosure *)p);
 274
 275             switch (info->type) {
 276             case BCO:
 277                 size = bco_sizeW((StgBCO *)p);
 278                 break;
 279
 280             case FUN:
 281             case THUNK:
 282             case CONSTR:
 283             case IND_PERM:
 284             case IND_OLDGEN_PERM:
 285             case BLACKHOLE:
 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             case MUT_ARR_WORDS:
 316                 size = arr_words_sizeW(stgCast(StgArrWords*,p));
 317                 break;
 318
 319             case ARR_PTRS:
 320             case MUT_ARR_PTRS:
 321             case MUT_ARR_PTRS_FROZEN:
 322                 size = arr_ptrs_sizeW((StgArrPtrs *)p);
 323                 break;
 324
 325             case TSO:
 326                 size = tso_sizeW((StgTSO *)p);
 327                 break;
 328
 329             default:
 330                 barf("heapCensus");
 331             }
 332             switch (RtsFlags.ProfFlags.doHeapProfile) {
 333             case HEAP_BY_INFOPTR:
 334               add_data((void *)(*p), size * sizeof(W_));
 335               break;
 336             case HEAP_BY_CLOSURE_TYPE:
 337               closure_types[info->type] += size * sizeof(W_);
 338               break;
 339             }
 340             p += size;
 341         }
 342         bd = bd->link;
 343     }
 344
 345     switch (RtsFlags.ProfFlags.doHeapProfile) {
 346     case HEAP_BY_INFOPTR:
 347       fprint_data(prof_file);
 348       break;
 349     case HEAP_BY_CLOSURE_TYPE:
 350       fprint_closure_types(prof_file);
 351       break;
 352     }
 353
 354     fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
 355 }
 356
 357 #endif
 358