ghc/rts/ProfHeap.c

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