ghc/rts/ProfHeap.c

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