ghc/rts/ProfHeap.c

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