ghc/rts/ProfHeap.c

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