ghc/rts/ProfHeap.c

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