ghc/rts/ProfHeap.c

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