ghc/rts/ProfHeap.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: ProfHeap.c,v 1.11 2000/04/05 15:32:08 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 #include "Hash.h"
  26 #include "StrHash.h"
  27
  28 #ifdef DEBUG_HEAP_PROF
  29 #include "Printer.h"
  30 static void initSymbolHash(void);
  31 static void clear_table_data(void);
  32 static void fprint_data(FILE *fp);
  33 #endif
  34
  35 char prof_filename[128];        /* urk */
  36
  37 /* -----------------------------------------------------------------------------
  38  * Hash tables.
  39  *
  40  * For profiling by module, constructor or closure type we need to be
  41  * able to get from a string describing the category to a structure
  42  * containing the counters for that category.  The strings aren't
  43  * unique (although gcc will do a fairly good job of commoning them up
  44  * where possible), so we have a many->one mapping.
  45  *
  46  * We represent the many->one mapping with a hash table.  In order to
  47  * find the unique counter associated with a string the first time we
  48  * encounter a particular string, we need another hash table, mapping
  49  * hashed strings to buckets of counters.  The string is hashed, then
  50  * the bucket is searched for an existing counter for the same
  51  * string.
  52  *
  53  * -------------------------------------------------------------------------- */
  54
  55 typedef struct _ctr {
  56     const char *str;
  57     unsigned long mem_resid;
  58     struct _ctr *next;
  59     struct _ctr *next_bucket;
  60 } prof_ctr;
  61
  62 /* Linked list of all existing ctr structs */
  63 prof_ctr *all_ctrs;
  64
  65 /* Hash table mapping (char *) -> (struct _ctr) */
  66 HashTable *str_to_ctr;
  67
  68 /* Hash table mapping hash_t (hashed string) -> (struct _ctr) */
  69 HashTable *hashstr_to_ctrs;
  70
  71 static void
  72 initHashTables( void )
  73 {
  74     str_to_ctr      = allocHashTable();
  75     hashstr_to_ctrs = allocHashTable();
  76     all_ctrs = NULL;
  77 }
  78
  79 static prof_ctr *
  80 strToCtr(const char *str)
  81 {
  82     prof_ctr *ctr;
  83
  84     ctr = lookupHashTable( str_to_ctr, (W_)str );
  85
  86     if (ctr != NULL) { return ctr; }
  87
  88     else {
  89         hash_t str_hash = hash_str((char *)str);
  90         prof_ctr *prev;
  91
  92         ctr = lookupHashTable( hashstr_to_ctrs, (W_)str_hash );
  93         prev = NULL;
  94
  95         for (; ctr != NULL; prev = ctr, ctr = ctr->next_bucket ) {
  96             if (!strcmp(ctr->str, str)) {
  97                 insertHashTable( str_to_ctr, (W_)str, ctr );
  98 #ifdef DEBUG
  99                 fprintf(stderr,"strToCtr: existing ctr for `%s'\n",str);
 100 #endif
 101                 return ctr;
 102             }
 103         }
 104
 105         ctr = stgMallocBytes(sizeof(prof_ctr), "strToCtr");
 106         ctr->mem_resid = 0;
 107         ctr->str = str;
 108         ctr->next_bucket = NULL;
 109         ctr->next = all_ctrs;
 110         all_ctrs = ctr;
 111
 112 #ifdef DEBUG
 113         fprintf(stderr,"strToCtr: new ctr for `%s'\n",str);
 114 #endif
 115
 116         if (prev != NULL) {
 117             prev->next_bucket = ctr;
 118         } else {
 119             insertHashTable( hashstr_to_ctrs, str_hash, ctr );
 120         }
 121         insertHashTable( str_to_ctr, (W_)str, ctr);
 122         return ctr;
 123     }
 124 }
 125
 126 static void
 127 clearCtrResid( void )
 128 {
 129     prof_ctr *ctr;
 130
 131     for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
 132         ctr->mem_resid = 0;
 133     }
 134 }
 135
 136 static void
 137 reportCtrResid(FILE *fp)
 138 {
 139     prof_ctr *ctr;
 140
 141     for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
 142         if (ctr->mem_resid != 0) {
 143             fprintf(fp,"   %s %ld\n", ctr->str, ctr->mem_resid * sizeof(W_));
 144         }
 145     }
 146 }
 147
 148 /* -------------------------------------------------------------------------- */
 149
 150 #ifdef DEBUG_HEAP_PROF
 151 FILE *prof_file;
 152
 153 void initProfiling1( void )
 154 {
 155 }
 156
 157 void initProfiling2( void )
 158 {
 159   initHeapProfiling();
 160 }
 161
 162 void endProfiling( void )
 163 {
 164   endHeapProfiling();
 165 }
 166 #endif /* DEBUG_HEAP_PROF */
 167
 168 nat
 169 initHeapProfiling(void)
 170 {
 171     if (! RtsFlags.ProfFlags.doHeapProfile) {
 172         return 0;
 173     }
 174
 175     fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
 176     fprintf(prof_file, "DATE \"%s\"\n", time_str());
 177
 178     fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
 179     fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
 180
 181     fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
 182     fprintf(prof_file, "END_SAMPLE 0.00\n");
 183
 184 #ifdef DEBUG_HEAP_PROF
 185     DEBUG_LoadSymbols(prog_argv[0]);
 186     initSymbolHash();
 187 #endif
 188
 189 #ifdef PROFILING
 190     initHashTables();
 191 #endif
 192
 193     return 0;
 194 }
 195
 196 void
 197 endHeapProfiling(void)
 198 {
 199     StgDouble seconds;
 200
 201     if (! RtsFlags.ProfFlags.doHeapProfile) {
 202         return;
 203     }
 204
 205     seconds = mut_user_time();
 206     fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 207     fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
 208     fclose(prof_file);
 209 }
 210
 211 #ifdef DEBUG_HEAP_PROF
 212 /* -----------------------------------------------------------------------------
 213    Hash table for symbols.
 214    -------------------------------------------------------------------------- */
 215
 216 typedef struct {
 217     const char *name;
 218     void *ptr;
 219     nat data;
 220 } symbol_info;
 221
 222 #define SYMBOL_HASH_SIZE 0x3fff
 223
 224 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
 225
 226 static inline nat
 227 hash(void *ptr)
 228 {
 229     return ((W_)ptr)>>4 & 0x3fff;
 230 }
 231
 232 static void
 233 initSymbolHash(void)
 234 {
 235     nat i;
 236
 237     for (i=0; i < SYMBOL_HASH_SIZE; i++) {
 238         symbol_hash[i].ptr = NULL;
 239     }
 240 }
 241
 242 static nat
 243 lookup_symbol(void *addr)
 244 {
 245     nat orig_bucket = hash(addr);
 246     nat bucket;
 247
 248     bucket = orig_bucket;
 249     while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
 250         if (symbol_hash[bucket].ptr == addr) {
 251             return bucket;
 252         }
 253         bucket++;
 254     }
 255     if (bucket == SYMBOL_HASH_SIZE) {
 256         bucket = 0;
 257         while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
 258             if (symbol_hash[bucket].ptr == addr) {
 259                 return bucket;
 260             }
 261             bucket++;
 262         }
 263         if (bucket == orig_bucket) {
 264             barf("out of symbol table space");
 265         }
 266     }
 267
 268     symbol_hash[bucket].ptr  = addr;
 269     lookupGHCName(addr,&symbol_hash[bucket].name);
 270     symbol_hash[bucket].data = 0;
 271     return bucket;
 272 }
 273
 274 static void
 275 clear_table_data(void)
 276 {
 277     nat i;
 278
 279     for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
 280         symbol_hash[i].data = 0;
 281     }
 282 }
 283
 284 static void
 285 fprint_data(FILE *fp)
 286 {
 287     nat i;
 288
 289     for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
 290         if (symbol_hash[i].data) {
 291             fprintf(fp, "   %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
 292         }
 293     }
 294 }
 295
 296 static inline void
 297 add_data(void *addr, nat data)
 298 {
 299     symbol_hash[lookup_symbol(addr)].data += data;
 300 }
 301
 302 /* -----------------------------------------------------------------------------
 303    Closure Type Profiling;
 304
 305    PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
 306    -------------------------------------------------------------------------- */
 307
 308 static nat closure_types[N_CLOSURE_TYPES];
 309
 310 static char *type_names[] = {
 311       "INVALID_OBJECT"
 312     , "CONSTR"
 313     , "CONSTR_INTLIKE"
 314     , "CONSTR_CHARLIKE"
 315     , "CONSTR_STATIC"
 316     , "CONSTR_NOCAF_STATIC"
 317
 318     , "FUN"
 319     , "FUN_STATIC"
 320
 321     , "THUNK"
 322     , "THUNK_STATIC"
 323     , "THUNK_SELECTOR"
 324
 325     , "BCO"
 326     , "AP_UPD"
 327
 328     , "PAP"
 329
 330     , "IND"
 331     , "IND_OLDGEN"
 332     , "IND_PERM"
 333     , "IND_OLDGEN_PERM"
 334     , "IND_STATIC"
 335
 336     , "RET_BCO"
 337     , "RET_SMALL"
 338     , "RET_VEC_SMALL"
 339     , "RET_BIG"
 340     , "RET_VEC_BIG"
 341     , "RET_DYN"
 342     , "UPDATE_FRAME"
 343     , "CATCH_FRAME"
 344     , "STOP_FRAME"
 345     , "SEQ_FRAME"
 346
 347     , "BLACKHOLE"
 348     , "BLACKHOLE_BQ"
 349     , "MVAR"
 350
 351     , "ARR_WORDS"
 352
 353     , "MUT_ARR_PTRS"
 354     , "MUT_ARR_PTRS_FROZEN"
 355     , "MUT_VAR"
 356
 357     , "WEAK"
 358     , "FOREIGN"
 359
 360     , "TSO"
 361
 362     , "BLOCKED_FETCH"
 363     , "FETCH_ME"
 364
 365     , "EVACUATED"
 366 };
 367
 368 static void
 369 fprint_closure_types(FILE *fp)
 370 {
 371   nat i;
 372
 373   for (i = 0; i < N_CLOSURE_TYPES; i++) {
 374     if (closure_types[i]) {
 375       fprintf(fp, "   %s %d\n", type_names[i], closure_types[i]);
 376     }
 377   }
 378 }
 379
 380 #endif /* DEBUG_HEAP_PROF */
 381
 382
 383 #ifdef PROFILING
 384 static void
 385 clearCCSResid(CostCentreStack *ccs)
 386 {
 387   IndexTable *i;
 388
 389   ccs->mem_resid = 0;
 390
 391   for (i = ccs->indexTable; i != 0; i = i->next) {
 392     if (!i->back_edge) {
 393       clearCCSResid(i->ccs);
 394     }
 395   }
 396 }
 397
 398 static void
 399 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
 400 {
 401   CostCentre *cc;
 402   CostCentreStack *prev;
 403
 404   cc = ccs->cc;
 405   prev = ccs->prevStack;
 406
 407   if (prev == NULL
 408       || prev->cc->is_caf != CC_IS_BORING
 409       || components == 1) {
 410     fprintf(fp,"%s",cc->label);
 411     return;
 412
 413   } else {
 414     fprint_ccs(fp, ccs->prevStack,components-1);
 415     fprintf(fp,"/%s",cc->label);
 416   }
 417 }
 418
 419 static void
 420 reportCCSResid(FILE *fp, CostCentreStack *ccs)
 421 {
 422   IndexTable *i;
 423
 424   if (ccs->mem_resid != 0) {
 425     fprintf(fp,"   ");
 426     fprint_ccs(fp,ccs,2/*print 2 components only*/);
 427     fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
 428   }
 429
 430   for (i = ccs->indexTable; i != 0; i = i->next) {
 431     if (!i->back_edge) {
 432       reportCCSResid(fp,i->ccs);
 433     }
 434   }
 435 }
 436 #endif
 437
 438 void
 439 heapCensus(void)
 440 {
 441   bdescr *bd;
 442   const StgInfoTable *info;
 443   StgDouble time;
 444   nat size;
 445   StgPtr p;
 446
 447 #ifdef DEBUG_HEAP_PROF
 448   switch (RtsFlags.ProfFlags.doHeapProfile) {
 449   case HEAP_BY_INFOPTR:
 450     clear_table_data();
 451     break;
 452   case HEAP_BY_CLOSURE_TYPE:
 453 #if 0
 454 #   error fix me
 455     memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
 456 #endif
 457     break;
 458   default:
 459     return;
 460   }
 461 #endif
 462
 463 #ifdef PROFILING
 464   switch (RtsFlags.ProfFlags.doHeapProfile) {
 465   case NO_HEAP_PROFILING:
 466       return;
 467   case HEAP_BY_CCS:
 468       /* zero all the residency counters */
 469       clearCCSResid(CCS_MAIN);
 470       break;
 471   case HEAP_BY_MOD:
 472   case HEAP_BY_DESCR:
 473   case HEAP_BY_TYPE:
 474       clearCtrResid();
 475       break;
 476   default:
 477       barf("heapCensus; doHeapProfile");
 478   }
 479 #endif
 480
 481   /* Only do heap profiling in a two-space heap */
 482   ASSERT(RtsFlags.GcFlags.generations == 1);
 483   bd = g0s0->to_space;
 484
 485   time = mut_user_time_during_GC();
 486   fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
 487
 488   while (bd != NULL) {
 489     p = bd->start;
 490     while (p < bd->free) {
 491       info = get_itbl((StgClosure *)p);
 492
 493       switch (info->type) {
 494       case BCO:
 495         size = bco_sizeW((StgBCO *)p);
 496         break;
 497
 498       case CONSTR:
 499         if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
 500           size = sizeofW(StgWeak);
 501           break;
 502         }
 503         /* else, fall through... */
 504
 505       case FUN:
 506       case THUNK:
 507       case IND_PERM:
 508       case IND_OLDGEN_PERM:
 509       case CAF_BLACKHOLE:
 510       case SE_CAF_BLACKHOLE:
 511       case SE_BLACKHOLE:
 512       case BLACKHOLE:
 513       case BLACKHOLE_BQ:
 514       case WEAK:
 515       case FOREIGN:
 516       case STABLE_NAME:
 517       case MVAR:
 518       case MUT_VAR:
 519       case CONSTR_INTLIKE:
 520       case CONSTR_CHARLIKE:
 521       case FUN_1_0:
 522       case FUN_0_1:
 523       case FUN_1_1:
 524       case FUN_0_2:
 525       case FUN_2_0:
 526       case THUNK_1_1:
 527       case THUNK_0_2:
 528       case THUNK_2_0:
 529       case CONSTR_1_0:
 530       case CONSTR_0_1:
 531       case CONSTR_1_1:
 532       case CONSTR_0_2:
 533       case CONSTR_2_0:
 534         size = sizeW_fromITBL(info);
 535         break;
 536
 537       case THUNK_1_0:           /* ToDo - shouldn't be here */
 538       case THUNK_0_1:           /* "  ditto  " */
 539       case THUNK_SELECTOR:
 540         size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 541         break;
 542
 543       case AP_UPD: /* we can treat this as being the same as a PAP */
 544       case PAP:
 545         size = pap_sizeW((StgPAP *)p);
 546         break;
 547
 548       case ARR_WORDS:
 549         size = arr_words_sizeW(stgCast(StgArrWords*,p));
 550         break;
 551
 552       case MUT_ARR_PTRS:
 553       case MUT_ARR_PTRS_FROZEN:
 554         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 555         break;
 556
 557       case TSO:
 558         size = tso_sizeW((StgTSO *)p);
 559         break;
 560
 561       default:
 562         barf("heapCensus");
 563       }
 564
 565 #ifdef DEBUG_HEAP_PROF
 566       switch (RtsFlags.ProfFlags.doHeapProfile) {
 567       case HEAP_BY_INFOPTR:
 568         add_data((void *)(*p), size * sizeof(W_));
 569         break;
 570       case HEAP_BY_CLOSURE_TYPE:
 571         closure_types[info->type] += size * sizeof(W_);
 572         break;
 573       }
 574 #endif
 575
 576 #ifdef PROFILING
 577       switch (RtsFlags.ProfFlags.doHeapProfile) {
 578       case HEAP_BY_CCS:
 579           ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
 580           break;
 581       case HEAP_BY_MOD:
 582           strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
 583               ->mem_resid += size;
 584           break;
 585       case HEAP_BY_DESCR:
 586           strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
 587               += size;
 588           break;
 589       case HEAP_BY_TYPE:
 590           strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
 591               += size;
 592           break;
 593       default:
 594           barf("heapCensus; doHeapProfile");
 595   }
 596 #endif
 597       p += size;
 598     }
 599     bd = bd->link;
 600   }
 601
 602 #ifdef DEBUG_HEAP_PROF
 603   switch (RtsFlags.ProfFlags.doHeapProfile) {
 604   case HEAP_BY_INFOPTR:
 605     fprint_data(prof_file);
 606     break;
 607   case HEAP_BY_CLOSURE_TYPE:
 608     fprint_closure_types(prof_file);
 609     break;
 610   }
 611 #endif
 612
 613 #ifdef PROFILING
 614   switch (RtsFlags.ProfFlags.doHeapProfile) {
 615   case HEAP_BY_CCS:
 616       reportCCSResid(prof_file,CCS_MAIN);
 617       break;
 618   case HEAP_BY_MOD:
 619   case HEAP_BY_DESCR:
 620   case HEAP_BY_TYPE:
 621       reportCtrResid(prof_file);
 622       break;
 623   default:
 624       barf("heapCensus; doHeapProfile");
 625   }
 626 #endif
 627
 628   fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
 629 }
 630
 631 #endif /* PROFILING || DEBUG_HEAP_PROF */
 632