ghc/rts/ProfHeap.c

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