ghc/rts/ProfHeap.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: ProfHeap.c,v 1.20 2000/12/11 12:36:59 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 #ifdef PROFILING
  54 typedef struct _ctr {
  55     const char *str;
  56     unsigned long mem_resid;
  57     struct _ctr *next;
  58     struct _ctr *next_bucket;
  59 } prof_ctr;
  60
  61 /* Linked list of all existing ctr structs */
  62 prof_ctr *all_ctrs;
  63
  64 /* Hash table mapping (char *) -> (struct _ctr) */
  65 HashTable *str_to_ctr;
  66
  67 /* Hash table mapping hash_t (hashed string) -> (struct _ctr) */
  68 HashTable *hashstr_to_ctrs;
  69
  70 static void
  71 initHashTables( void )
  72 {
  73     str_to_ctr      = allocHashTable();
  74     hashstr_to_ctrs = allocHashTable();
  75     all_ctrs = NULL;
  76 }
  77
  78 static prof_ctr *
  79 strToCtr(const char *str)
  80 {
  81     prof_ctr *ctr;
  82
  83     ctr = lookupHashTable( str_to_ctr, (W_)str );
  84
  85     if (ctr != NULL) { return ctr; }
  86
  87     else {
  88         hash_t str_hash = hash_str((char *)str);
  89         prof_ctr *prev;
  90
  91         ctr = lookupHashTable( hashstr_to_ctrs, (W_)str_hash );
  92         prev = NULL;
  93
  94         for (; ctr != NULL; prev = ctr, ctr = ctr->next_bucket ) {
  95             if (!strcmp(ctr->str, str)) {
  96                 insertHashTable( str_to_ctr, (W_)str, ctr );
  97 #ifdef DEBUG
  98                 fprintf(stderr,"strToCtr: existing ctr for `%s'\n",str);
  99 #endif
 100                 return ctr;
 101             }
 102         }
 103
 104         ctr = stgMallocBytes(sizeof(prof_ctr), "strToCtr");
 105         ctr->mem_resid = 0;
 106         ctr->str = str;
 107         ctr->next_bucket = NULL;
 108         ctr->next = all_ctrs;
 109         all_ctrs = ctr;
 110
 111 #ifdef DEBUG
 112         fprintf(stderr,"strToCtr: new ctr for `%s'\n",str);
 113 #endif
 114
 115         if (prev != NULL) {
 116             prev->next_bucket = ctr;
 117         } else {
 118             insertHashTable( hashstr_to_ctrs, str_hash, ctr );
 119         }
 120         insertHashTable( str_to_ctr, (W_)str, ctr);
 121         return ctr;
 122     }
 123 }
 124
 125 static void
 126 clearCtrResid( void )
 127 {
 128     prof_ctr *ctr;
 129
 130     for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
 131         ctr->mem_resid = 0;
 132     }
 133 }
 134
 135 static void
 136 reportCtrResid(FILE *fp)
 137 {
 138     prof_ctr *ctr;
 139
 140     for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
 141         if (ctr->mem_resid != 0) {
 142             fprintf(fp,"   %s %ld\n", ctr->str, ctr->mem_resid * sizeof(W_));
 143         }
 144     }
 145 }
 146 #endif /* PROFILING */
 147
 148 /* -------------------------------------------------------------------------- */
 149
 150 #ifdef DEBUG_HEAP_PROF
 151 FILE *hp_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(hp_file, "JOB \"%s\"\n", prog_argv[0]);
 176     fprintf(hp_file, "DATE \"%s\"\n", time_str());
 177
 178     fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
 179     fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
 180
 181     fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
 182     fprintf(hp_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(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 207     fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
 208     fclose(hp_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(hp_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
 495       case CONSTR:
 496         if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info
 497             && !(LOOKS_LIKE_GHC_INFO(*(p + sizeW_fromITBL(info))))) {
 498             size = sizeofW(StgWeak);
 499             break;
 500         }
 501         /* else, fall through... */
 502
 503       case BCO:
 504       case FUN:
 505       case THUNK:
 506       case IND_PERM:
 507       case IND_OLDGEN_PERM:
 508       case CAF_BLACKHOLE:
 509       case SE_CAF_BLACKHOLE:
 510       case SE_BLACKHOLE:
 511       case BLACKHOLE:
 512       case BLACKHOLE_BQ:
 513       case WEAK:
 514       case FOREIGN:
 515       case STABLE_NAME:
 516       case MVAR:
 517       case MUT_VAR:
 518       case CONSTR_INTLIKE:
 519       case CONSTR_CHARLIKE:
 520       case FUN_1_0:
 521       case FUN_0_1:
 522       case FUN_1_1:
 523       case FUN_0_2:
 524       case FUN_2_0:
 525       case THUNK_1_1:
 526       case THUNK_0_2:
 527       case THUNK_2_0:
 528       case CONSTR_1_0:
 529       case CONSTR_0_1:
 530       case CONSTR_1_1:
 531       case CONSTR_0_2:
 532       case CONSTR_2_0:
 533         size = sizeW_fromITBL(info);
 534         break;
 535
 536       case THUNK_1_0:           /* ToDo - shouldn't be here */
 537       case THUNK_0_1:           /* "  ditto  " */
 538       case THUNK_SELECTOR:
 539         size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 540         break;
 541
 542       case AP_UPD: /* we can treat this as being the same as a PAP */
 543       case PAP:
 544         size = pap_sizeW((StgPAP *)p);
 545         break;
 546
 547       case ARR_WORDS:
 548         size = arr_words_sizeW(stgCast(StgArrWords*,p));
 549         break;
 550
 551       case MUT_ARR_PTRS:
 552       case MUT_ARR_PTRS_FROZEN:
 553         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 554         break;
 555
 556       case TSO:
 557         size = tso_sizeW((StgTSO *)p);
 558         break;
 559
 560       default:
 561         barf("heapCensus");
 562       }
 563
 564 #ifdef DEBUG_HEAP_PROF
 565       switch (RtsFlags.ProfFlags.doHeapProfile) {
 566       case HEAP_BY_INFOPTR:
 567         add_data((void *)(*p), size * sizeof(W_));
 568         break;
 569       case HEAP_BY_CLOSURE_TYPE:
 570         closure_types[info->type] += size * sizeof(W_);
 571         break;
 572       }
 573 #endif
 574
 575 #ifdef PROFILING
 576       switch (RtsFlags.ProfFlags.doHeapProfile) {
 577       case HEAP_BY_CCS:
 578           ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
 579           break;
 580       case HEAP_BY_MOD:
 581           strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
 582               ->mem_resid += size;
 583           break;
 584       case HEAP_BY_DESCR:
 585           strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
 586               += size;
 587           break;
 588       case HEAP_BY_TYPE:
 589           strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
 590               += size;
 591           break;
 592       default:
 593           barf("heapCensus; doHeapProfile");
 594   }
 595 #endif
 596       p += size;
 597     }
 598     bd = bd->link;
 599   }
 600
 601 #ifdef DEBUG_HEAP_PROF
 602   switch (RtsFlags.ProfFlags.doHeapProfile) {
 603   case HEAP_BY_INFOPTR:
 604     fprint_data(hp_file);
 605     break;
 606   case HEAP_BY_CLOSURE_TYPE:
 607     fprint_closure_types(hp_file);
 608     break;
 609   }
 610 #endif
 611
 612 #ifdef PROFILING
 613   switch (RtsFlags.ProfFlags.doHeapProfile) {
 614   case HEAP_BY_CCS:
 615       reportCCSResid(hp_file,CCS_MAIN);
 616       break;
 617   case HEAP_BY_MOD:
 618   case HEAP_BY_DESCR:
 619   case HEAP_BY_TYPE:
 620       reportCtrResid(hp_file);
 621       break;
 622   default:
 623       barf("heapCensus; doHeapProfile");
 624   }
 625 #endif
 626
 627   fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
 628 }
 629
 630 #endif /* PROFILING || DEBUG_HEAP_PROF */
 631