ghc/rts/ProfHeap.c

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