ghc/rts/ProfHeap.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: ProfHeap.c,v 1.24 2001/08/07 19:34:01 ken 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 %lu\n", symbol_hash[i].name, (unsigned long)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 %lu\n", type_names[i], (unsigned long)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 #ifdef PROFILING
 524   nat elapsed;
 525 #endif
 526
 527 #ifdef DEBUG_HEAP_PROF
 528   switch (RtsFlags.ProfFlags.doHeapProfile) {
 529   case HEAP_BY_INFOPTR:
 530     clear_table_data();
 531     break;
 532   case HEAP_BY_CLOSURE_TYPE:
 533 #if 0
 534 #   error fix me
 535     memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
 536 #endif
 537     break;
 538   default:
 539     return;
 540   }
 541 #endif
 542
 543 #ifdef PROFILING
 544   /*
 545    * We only continue iff we've waited long enough,
 546    * otherwise, we just dont do the census.
 547    */
 548
 549   time = mut_user_time_during_GC();
 550   elapsed = (time - time_of_last_heapCensus) * 1000;
 551   if (elapsed < RtsFlags.ProfFlags.profileFrequency) {
 552       return;
 553     }
 554   time_of_last_heapCensus = time;
 555 #endif
 556
 557
 558 #ifdef PROFILING
 559   switch (RtsFlags.ProfFlags.doHeapProfile) {
 560   case NO_HEAP_PROFILING:
 561       return;
 562   case HEAP_BY_CCS:
 563       /* zero all the residency counters */
 564       clearCCSResid(CCS_MAIN);
 565       break;
 566   case HEAP_BY_MOD:
 567   case HEAP_BY_DESCR:
 568   case HEAP_BY_TYPE:
 569       clearCtrResid();
 570       break;
 571   default:
 572       barf("heapCensus; doHeapProfile");
 573   }
 574 #endif
 575
 576   /* Only do heap profiling in a two-space heap */
 577   ASSERT(RtsFlags.GcFlags.generations == 1);
 578   bd = g0s0->to_blocks;
 579
 580   fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
 581
 582   while (bd != NULL) {
 583     p = bd->start;
 584     while (p < bd->free) {
 585       info = get_itbl((StgClosure *)p);
 586
 587       switch (info->type) {
 588
 589       case CONSTR:
 590         if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info
 591             && !(LOOKS_LIKE_GHC_INFO(*(p + sizeW_fromITBL(info))))) {
 592             size = sizeofW(StgWeak);
 593             break;
 594         }
 595         /* else, fall through... */
 596
 597       case BCO:
 598       case FUN:
 599       case THUNK:
 600       case IND_PERM:
 601       case IND_OLDGEN_PERM:
 602       case CAF_BLACKHOLE:
 603       case SE_CAF_BLACKHOLE:
 604       case SE_BLACKHOLE:
 605       case BLACKHOLE:
 606       case BLACKHOLE_BQ:
 607       case WEAK:
 608       case FOREIGN:
 609       case STABLE_NAME:
 610       case MVAR:
 611       case MUT_VAR:
 612       case CONSTR_INTLIKE:
 613       case CONSTR_CHARLIKE:
 614       case FUN_1_0:
 615       case FUN_0_1:
 616       case FUN_1_1:
 617       case FUN_0_2:
 618       case FUN_2_0:
 619       case THUNK_1_1:
 620       case THUNK_0_2:
 621       case THUNK_2_0:
 622       case CONSTR_1_0:
 623       case CONSTR_0_1:
 624       case CONSTR_1_1:
 625       case CONSTR_0_2:
 626       case CONSTR_2_0:
 627         size = sizeW_fromITBL(info);
 628         break;
 629
 630       case THUNK_1_0:           /* ToDo - shouldn't be here */
 631       case THUNK_0_1:           /* "  ditto  " */
 632       case THUNK_SELECTOR:
 633         size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 634         break;
 635
 636       case AP_UPD: /* we can treat this as being the same as a PAP */
 637       case PAP:
 638         size = pap_sizeW((StgPAP *)p);
 639         break;
 640
 641       case ARR_WORDS:
 642         size = arr_words_sizeW(stgCast(StgArrWords*,p));
 643         break;
 644
 645       case MUT_ARR_PTRS:
 646       case MUT_ARR_PTRS_FROZEN:
 647         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 648         break;
 649
 650       case TSO:
 651         size = tso_sizeW((StgTSO *)p);
 652         break;
 653
 654       default:
 655         barf("heapCensus");
 656       }
 657
 658 #ifdef DEBUG_HEAP_PROF
 659       switch (RtsFlags.ProfFlags.doHeapProfile) {
 660       case HEAP_BY_INFOPTR:
 661         add_data((void *)(*p), size * sizeof(W_));
 662         break;
 663       case HEAP_BY_CLOSURE_TYPE:
 664         closure_types[info->type] += size * sizeof(W_);
 665         break;
 666       }
 667 #endif
 668
 669 #     ifdef PROFILING
 670       if (satisfies_constraints((StgClosure*)p)) {
 671          switch (RtsFlags.ProfFlags.doHeapProfile) {
 672             case HEAP_BY_CCS:
 673                ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
 674                break;
 675             case HEAP_BY_MOD:
 676                strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
 677                   ->mem_resid += size;
 678                break;
 679             case HEAP_BY_DESCR:
 680                strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
 681                   += size;
 682                break;
 683             case HEAP_BY_TYPE:
 684                strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
 685                   += size;
 686                break;
 687             default:
 688                barf("heapCensus; doHeapProfile");
 689          }
 690       }
 691 #     endif
 692
 693       p += size;
 694     }
 695     bd = bd->link;
 696   }
 697
 698 #ifdef DEBUG_HEAP_PROF
 699   switch (RtsFlags.ProfFlags.doHeapProfile) {
 700   case HEAP_BY_INFOPTR:
 701     fprint_data(hp_file);
 702     break;
 703   case HEAP_BY_CLOSURE_TYPE:
 704     fprint_closure_types(hp_file);
 705     break;
 706   }
 707 #endif
 708
 709 #ifdef PROFILING
 710   switch (RtsFlags.ProfFlags.doHeapProfile) {
 711   case HEAP_BY_CCS:
 712       reportCCSResid(hp_file,CCS_MAIN);
 713       break;
 714   case HEAP_BY_MOD:
 715   case HEAP_BY_DESCR:
 716   case HEAP_BY_TYPE:
 717       reportCtrResid(hp_file);
 718       break;
 719   default:
 720       barf("heapCensus; doHeapProfile");
 721   }
 722 #endif
 723
 724   fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
 725 }
 726
 727 #endif /* PROFILING || DEBUG_HEAP_PROF */
 728