ghc/rts/ProfHeap.c

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