ghc/rts/ProfHeap.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: ProfHeap.c,v 1.25 2001/08/14 13:40:09 sewardj 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 "PosixSource.h"
  19 #include "Rts.h"
  20 #include "RtsUtils.h"
  21 #include "RtsFlags.h"
  22 #include "Profiling.h"
  23 #include "Storage.h"
  24 #include "ProfHeap.h"
  25 #include "Stats.h"
  26 #include "Hash.h"
  27 #include "StrHash.h"
  28
  29 #ifdef DEBUG_HEAP_PROF
  30 #include "Printer.h"
  31 static void initSymbolHash(void);
  32 static void clear_table_data(void);
  33 static void fprint_data(FILE *fp);
  34 #endif
  35
  36 /* -----------------------------------------------------------------------------
  37  * Hash tables.
  38  *
  39  * For profiling by module, constructor or closure type we need to be
  40  * able to get from a string describing the category to a structure
  41  * containing the counters for that category.  The strings aren't
  42  * unique (although gcc will do a fairly good job of commoning them up
  43  * where possible), so we have a many->one mapping.
  44  *
  45  * We represent the many->one mapping with a hash table.  In order to
  46  * find the unique counter associated with a string the first time we
  47  * encounter a particular string, we need another hash table, mapping
  48  * hashed strings to buckets of counters.  The string is hashed, then
  49  * the bucket is searched for an existing counter for the same
  50  * string.
  51  *
  52  * -------------------------------------------------------------------------- */
  53
  54 #ifdef PROFILING
  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 #endif /* PROFILING */
 148
 149 /* -------------------------------------------------------------------------- */
 150
 151 #ifdef DEBUG_HEAP_PROF
 152 FILE *hp_file;
 153
 154 void initProfiling1( void )
 155 {
 156 }
 157
 158 void initProfiling2( void )
 159 {
 160   initHeapProfiling();
 161 }
 162
 163 void endProfiling( void )
 164 {
 165   endHeapProfiling();
 166 }
 167 #endif /* DEBUG_HEAP_PROF */
 168
 169 nat
 170 initHeapProfiling(void)
 171 {
 172     if (! RtsFlags.ProfFlags.doHeapProfile) {
 173         return 0;
 174     }
 175
 176     fprintf(hp_file, "JOB \"%s", prog_argv[0]);
 177
 178 #   ifdef PROFILING
 179     switch (RtsFlags.ProfFlags.doHeapProfile) {
 180        case HEAP_BY_CCS:   fprintf(hp_file, " -h%c", CCchar); break;
 181        case HEAP_BY_MOD:   fprintf(hp_file, " -h%c", MODchar); break;
 182        case HEAP_BY_DESCR: fprintf(hp_file, " -h%c", DESCRchar); break;
 183        case HEAP_BY_TYPE:  fprintf(hp_file, " -h%c", TYPEchar); break;
 184        default: /* nothing */
 185     }
 186     if (RtsFlags.ProfFlags.ccSelector)
 187        fprintf(hp_file, " -hc{%s}", RtsFlags.ProfFlags.ccSelector);
 188     if (RtsFlags.ProfFlags.modSelector)
 189        fprintf(hp_file, " -hm{%s}", RtsFlags.ProfFlags.modSelector);
 190     if (RtsFlags.ProfFlags.descrSelector)
 191        fprintf(hp_file, " -hd{%s}", RtsFlags.ProfFlags.descrSelector);
 192     if (RtsFlags.ProfFlags.typeSelector)
 193        fprintf(hp_file, " -hy{%s}", RtsFlags.ProfFlags.typeSelector);
 194 #   endif /* PROFILING */
 195
 196     fprintf(hp_file, "\"\n" );
 197
 198     fprintf(hp_file, "DATE \"%s\"\n", time_str());
 199
 200     fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
 201     fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
 202
 203     fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
 204     fprintf(hp_file, "END_SAMPLE 0.00\n");
 205
 206 #ifdef DEBUG_HEAP_PROF
 207     DEBUG_LoadSymbols(prog_argv[0]);
 208     initSymbolHash();
 209 #endif
 210
 211 #ifdef PROFILING
 212     initHashTables();
 213 #endif
 214
 215     return 0;
 216 }
 217
 218 void
 219 endHeapProfiling(void)
 220 {
 221     StgDouble seconds;
 222
 223     if (! RtsFlags.ProfFlags.doHeapProfile) {
 224         return;
 225     }
 226
 227     seconds = mut_user_time();
 228     fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 229     fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
 230     fclose(hp_file);
 231 }
 232
 233 #ifdef DEBUG_HEAP_PROF
 234 /* -----------------------------------------------------------------------------
 235    Hash table for symbols.
 236    -------------------------------------------------------------------------- */
 237
 238 typedef struct {
 239     const char *name;
 240     void *ptr;
 241     nat data;
 242 } symbol_info;
 243
 244 #define SYMBOL_HASH_SIZE 0x3fff
 245
 246 symbol_info symbol_hash[SYMBOL_HASH_SIZE];
 247
 248 static inline nat
 249 hash(void *ptr)
 250 {
 251     return ((W_)ptr)>>4 & 0x3fff;
 252 }
 253
 254 static void
 255 initSymbolHash(void)
 256 {
 257     nat i;
 258
 259     for (i=0; i < SYMBOL_HASH_SIZE; i++) {
 260         symbol_hash[i].ptr = NULL;
 261     }
 262 }
 263
 264 static nat
 265 lookup_symbol(void *addr)
 266 {
 267     nat orig_bucket = hash(addr);
 268     nat bucket;
 269
 270     bucket = orig_bucket;
 271     while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
 272         if (symbol_hash[bucket].ptr == addr) {
 273             return bucket;
 274         }
 275         bucket++;
 276     }
 277     if (bucket == SYMBOL_HASH_SIZE) {
 278         bucket = 0;
 279         while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
 280             if (symbol_hash[bucket].ptr == addr) {
 281                 return bucket;
 282             }
 283             bucket++;
 284         }
 285         if (bucket == orig_bucket) {
 286             barf("out of symbol table space");
 287         }
 288     }
 289
 290     symbol_hash[bucket].ptr  = addr;
 291     lookupGHCName(addr,&symbol_hash[bucket].name);
 292     symbol_hash[bucket].data = 0;
 293     return bucket;
 294 }
 295
 296 static void
 297 clear_table_data(void)
 298 {
 299     nat i;
 300
 301     for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
 302         symbol_hash[i].data = 0;
 303     }
 304 }
 305
 306 static void
 307 fprint_data(FILE *fp)
 308 {
 309     nat i;
 310     for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
 311         if (symbol_hash[i].data > 0) {
 312             fprintf(fp, "   %s %lu\n", symbol_hash[i].name, (unsigned long)symbol_hash[i].data);
 313         }
 314     }
 315 }
 316
 317 static inline void
 318 add_data(void *addr, nat data)
 319 {
 320     symbol_hash[lookup_symbol(addr)].data += data;
 321 }
 322
 323 /* -----------------------------------------------------------------------------
 324    Closure Type Profiling;
 325
 326    PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
 327    -------------------------------------------------------------------------- */
 328
 329 static nat closure_types[N_CLOSURE_TYPES];
 330
 331 static char *type_names[] = {
 332       "INVALID_OBJECT"
 333     , "CONSTR"
 334     , "CONSTR_INTLIKE"
 335     , "CONSTR_CHARLIKE"
 336     , "CONSTR_STATIC"
 337     , "CONSTR_NOCAF_STATIC"
 338
 339     , "FUN"
 340     , "FUN_STATIC"
 341
 342     , "THUNK"
 343     , "THUNK_STATIC"
 344     , "THUNK_SELECTOR"
 345
 346     , "BCO"
 347     , "AP_UPD"
 348
 349     , "PAP"
 350
 351     , "IND"
 352     , "IND_OLDGEN"
 353     , "IND_PERM"
 354     , "IND_OLDGEN_PERM"
 355     , "IND_STATIC"
 356
 357     , "RET_BCO"
 358     , "RET_SMALL"
 359     , "RET_VEC_SMALL"
 360     , "RET_BIG"
 361     , "RET_VEC_BIG"
 362     , "RET_DYN"
 363     , "UPDATE_FRAME"
 364     , "CATCH_FRAME"
 365     , "STOP_FRAME"
 366     , "SEQ_FRAME"
 367
 368     , "BLACKHOLE"
 369     , "BLACKHOLE_BQ"
 370     , "MVAR"
 371
 372     , "ARR_WORDS"
 373
 374     , "MUT_ARR_PTRS"
 375     , "MUT_ARR_PTRS_FROZEN"
 376     , "MUT_VAR"
 377
 378     , "WEAK"
 379     , "FOREIGN"
 380
 381     , "TSO"
 382
 383     , "BLOCKED_FETCH"
 384     , "FETCH_ME"
 385
 386     , "EVACUATED"
 387 };
 388
 389 static void
 390 fprint_closure_types(FILE *fp)
 391 {
 392   nat i;
 393
 394   for (i = 0; i < N_CLOSURE_TYPES; i++) {
 395     if (closure_types[i]) {
 396       fprintf(fp, "   %s %lu\n", type_names[i], (unsigned long)closure_types[i]);
 397     }
 398   }
 399 }
 400
 401 #endif /* DEBUG_HEAP_PROF */
 402
 403
 404 #ifdef PROFILING
 405 static void
 406 clearCCSResid(CostCentreStack *ccs)
 407 {
 408   IndexTable *i;
 409
 410   ccs->mem_resid = 0;
 411
 412   for (i = ccs->indexTable; i != 0; i = i->next) {
 413     if (!i->back_edge) {
 414       clearCCSResid(i->ccs);
 415     }
 416   }
 417 }
 418
 419 static void
 420 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
 421 {
 422   CostCentre *cc;
 423   CostCentreStack *prev;
 424
 425   cc = ccs->cc;
 426   prev = ccs->prevStack;
 427
 428   if (prev == NULL
 429       || prev->cc->is_caf != CC_IS_BORING
 430       || components == 1) {
 431     fprintf(fp,"%s",cc->label);
 432     return;
 433
 434   } else {
 435     fprint_ccs(fp, ccs->prevStack,components-1);
 436     fprintf(fp,"/%s",cc->label);
 437   }
 438 }
 439
 440 static void
 441 reportCCSResid(FILE *fp, CostCentreStack *ccs)
 442 {
 443   IndexTable *i;
 444
 445   if (ccs->mem_resid != 0) {
 446     fprintf(fp,"   ");
 447     fprint_ccs(fp,ccs,2/*print 2 components only*/);
 448     fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
 449   }
 450
 451   for (i = ccs->indexTable; i != 0; i = i->next) {
 452     if (!i->back_edge) {
 453       reportCCSResid(fp,i->ccs);
 454     }
 455   }
 456 }
 457
 458 static
 459 rtsBool str_matches_selector ( char* str, char* sel )
 460 {
 461    char* p;
 462    /* fprintf(stderr, "str_matches_selector %s %s\n", str, sel); */
 463    while (1) {
 464       /* Compare str against wherever we've got to in sel. */
 465       p = str;
 466       while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
 467          p++; sel++;
 468       }
 469       /* Match if all of str used and have reached the end of a sel
 470          fragment. */
 471       if (*p == '\0' && (*sel == ',' || *sel == '\0'))
 472          return rtsTrue;
 473
 474       /* No match.  Advance sel to the start of the next elem. */
 475       while (*sel != ',' && *sel != '\0') sel++;
 476       if (*sel == ',') sel++;
 477
 478       /* Run out of sel ?? */
 479       if (*sel == '\0') return rtsFalse;
 480    }
 481 }
 482
 483 /* Figure out whether a closure should be counted in this census, by
 484    testing against all the specified constraints. */
 485 static
 486 rtsBool satisfies_constraints ( StgClosure* p )
 487 {
 488    rtsBool b;
 489    if (RtsFlags.ProfFlags.modSelector) {
 490       b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module,
 491                                 RtsFlags.ProfFlags.modSelector );
 492       if (!b) return rtsFalse;
 493    }
 494    if (RtsFlags.ProfFlags.descrSelector) {
 495       b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_desc,
 496                                 RtsFlags.ProfFlags.descrSelector );
 497       if (!b) return rtsFalse;
 498    }
 499    if (RtsFlags.ProfFlags.typeSelector) {
 500       b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_type,
 501                                 RtsFlags.ProfFlags.typeSelector );
 502       if (!b) return rtsFalse;
 503    }
 504    if (RtsFlags.ProfFlags.ccSelector) {
 505       b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->label,
 506                                 RtsFlags.ProfFlags.ccSelector );
 507       if (!b) return rtsFalse;
 508    }
 509    return rtsTrue;
 510 }
 511 #endif /* PROFILING */
 512
 513
 514 static double time_of_last_heapCensus = 0.0;
 515
 516 void
 517 heapCensus(void)
 518 {
 519   bdescr *bd;
 520   const StgInfoTable *info;
 521   StgDouble time;
 522   nat size;
 523   StgPtr p;
 524 #ifdef PROFILING
 525   nat elapsed;
 526 #endif
 527
 528 #ifdef DEBUG_HEAP_PROF
 529   switch (RtsFlags.ProfFlags.doHeapProfile) {
 530   case HEAP_BY_INFOPTR:
 531     clear_table_data();
 532     break;
 533   case HEAP_BY_CLOSURE_TYPE:
 534 #if 0
 535 #   error fix me
 536     memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
 537 #endif
 538     break;
 539   default:
 540     return;
 541   }
 542 #endif
 543
 544 #ifdef PROFILING
 545   /*
 546    * We only continue iff we've waited long enough,
 547    * otherwise, we just dont do the census.
 548    */
 549
 550   time = mut_user_time_during_GC();
 551   elapsed = (time - time_of_last_heapCensus) * 1000;
 552   if (elapsed < RtsFlags.ProfFlags.profileFrequency) {
 553       return;
 554     }
 555   time_of_last_heapCensus = time;
 556 #endif
 557
 558
 559 #ifdef PROFILING
 560   switch (RtsFlags.ProfFlags.doHeapProfile) {
 561   case NO_HEAP_PROFILING:
 562       return;
 563   case HEAP_BY_CCS:
 564       /* zero all the residency counters */
 565       clearCCSResid(CCS_MAIN);
 566       break;
 567   case HEAP_BY_MOD:
 568   case HEAP_BY_DESCR:
 569   case HEAP_BY_TYPE:
 570       clearCtrResid();
 571       break;
 572   default:
 573       barf("heapCensus; doHeapProfile");
 574   }
 575 #endif
 576
 577   /* Only do heap profiling in a two-space heap */
 578   ASSERT(RtsFlags.GcFlags.generations == 1);
 579   bd = g0s0->to_blocks;
 580
 581   fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
 582
 583   while (bd != NULL) {
 584     p = bd->start;
 585     while (p < bd->free) {
 586       info = get_itbl((StgClosure *)p);
 587
 588       switch (info->type) {
 589
 590       case CONSTR:
 591         if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info
 592             && !(LOOKS_LIKE_GHC_INFO(*(p + sizeW_fromITBL(info))))) {
 593             size = sizeofW(StgWeak);
 594             break;
 595         }
 596         /* else, fall through... */
 597
 598       case BCO:
 599       case FUN:
 600       case THUNK:
 601       case IND_PERM:
 602       case IND_OLDGEN_PERM:
 603       case CAF_BLACKHOLE:
 604       case SE_CAF_BLACKHOLE:
 605       case SE_BLACKHOLE:
 606       case BLACKHOLE:
 607       case BLACKHOLE_BQ:
 608       case WEAK:
 609       case FOREIGN:
 610       case STABLE_NAME:
 611       case MVAR:
 612       case MUT_VAR:
 613       case CONSTR_INTLIKE:
 614       case CONSTR_CHARLIKE:
 615       case FUN_1_0:
 616       case FUN_0_1:
 617       case FUN_1_1:
 618       case FUN_0_2:
 619       case FUN_2_0:
 620       case THUNK_1_1:
 621       case THUNK_0_2:
 622       case THUNK_2_0:
 623       case CONSTR_1_0:
 624       case CONSTR_0_1:
 625       case CONSTR_1_1:
 626       case CONSTR_0_2:
 627       case CONSTR_2_0:
 628         size = sizeW_fromITBL(info);
 629         break;
 630
 631       case THUNK_1_0:           /* ToDo - shouldn't be here */
 632       case THUNK_0_1:           /* "  ditto  " */
 633       case THUNK_SELECTOR:
 634         size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 635         break;
 636
 637       case AP_UPD: /* we can treat this as being the same as a PAP */
 638       case PAP:
 639         size = pap_sizeW((StgPAP *)p);
 640         break;
 641
 642       case ARR_WORDS:
 643         size = arr_words_sizeW(stgCast(StgArrWords*,p));
 644         break;
 645
 646       case MUT_ARR_PTRS:
 647       case MUT_ARR_PTRS_FROZEN:
 648         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 649         break;
 650
 651       case TSO:
 652         size = tso_sizeW((StgTSO *)p);
 653         break;
 654
 655       default:
 656         barf("heapCensus");
 657       }
 658
 659 #ifdef DEBUG_HEAP_PROF
 660       switch (RtsFlags.ProfFlags.doHeapProfile) {
 661       case HEAP_BY_INFOPTR:
 662         add_data((void *)(*p), size * sizeof(W_));
 663         break;
 664       case HEAP_BY_CLOSURE_TYPE:
 665         closure_types[info->type] += size * sizeof(W_);
 666         break;
 667       }
 668 #endif
 669
 670 #     ifdef PROFILING
 671       if (satisfies_constraints((StgClosure*)p)) {
 672          switch (RtsFlags.ProfFlags.doHeapProfile) {
 673             case HEAP_BY_CCS:
 674                ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
 675                break;
 676             case HEAP_BY_MOD:
 677                strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
 678                   ->mem_resid += size;
 679                break;
 680             case HEAP_BY_DESCR:
 681                strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
 682                   += size;
 683                break;
 684             case HEAP_BY_TYPE:
 685                strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
 686                   += size;
 687                break;
 688             default:
 689                barf("heapCensus; doHeapProfile");
 690          }
 691       }
 692 #     endif
 693
 694       p += size;
 695     }
 696     bd = bd->link;
 697   }
 698
 699 #ifdef DEBUG_HEAP_PROF
 700   switch (RtsFlags.ProfFlags.doHeapProfile) {
 701   case HEAP_BY_INFOPTR:
 702     fprint_data(hp_file);
 703     break;
 704   case HEAP_BY_CLOSURE_TYPE:
 705     fprint_closure_types(hp_file);
 706     break;
 707   }
 708 #endif
 709
 710 #ifdef PROFILING
 711   switch (RtsFlags.ProfFlags.doHeapProfile) {
 712   case HEAP_BY_CCS:
 713       reportCCSResid(hp_file,CCS_MAIN);
 714       break;
 715   case HEAP_BY_MOD:
 716   case HEAP_BY_DESCR:
 717   case HEAP_BY_TYPE:
 718       reportCtrResid(hp_file);
 719       break;
 720   default:
 721       barf("heapCensus; doHeapProfile");
 722   }
 723 #endif
 724
 725   fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
 726 }
 727
 728 #endif /* PROFILING || DEBUG_HEAP_PROF */
 729