ghc/rts/ProfHeap.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: ProfHeap.c,v 1.29 2001/11/28 15:01:02 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 "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 #include "RetainerProfile.h"
  29 #include "LdvProfile.h"
  30 #include "Arena.h"
  31
  32 #ifdef DEBUG_HEAP_PROF
  33 #include "Printer.h"
  34 static void fprint_data(FILE *fp);
  35 #endif
  36
  37 /* -----------------------------------------------------------------------------
  38  * era stores the current time period.  It is the same as the
  39  * number of censuses that have been performed.
  40  *
  41  * RESTRICTION:
  42  *   era must be no longer than LDV_SHIFT (15 or 30) bits.
  43  * Invariants:
  44  *   era is initialized to 0 in initHeapProfiling().
  45  *
  46  * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling().
  47  * When era reaches max_era, the profiling stops because a closure can
  48  * store only up to (max_era - 1) as its creation or last use time.
  49  * -------------------------------------------------------------------------- */
  50 nat era;
  51 static nat max_era;
  52
  53 /* -----------------------------------------------------------------------------
  54  * Counters
  55  *
  56  * For most heap profiles each closure identity gets a simple count
  57  * of live words in the heap at each census.  However, if we're
  58  * selecting by biography, then we have to keep the various
  59  * lag/drag/void counters for each identity.
  60  * -------------------------------------------------------------------------- */
  61 typedef struct _counter {
  62     void *identity;
  63     union {
  64         nat resid;
  65         struct {
  66             int prim;     // total size of 'inherently used' closures
  67             int not_used; // total size of 'never used' closures
  68             int used;     // total size of 'used at least once' closures
  69             int void_total;  // current total size of 'destroyed without being used' closures
  70             int drag_total;  // current total size of 'used at least once and waiting to die'
  71         } ldv;
  72     } c;
  73     struct _counter *next;
  74 } counter;
  75
  76 static inline void
  77 initLDVCtr( counter *ctr )
  78 {
  79     ctr->c.ldv.prim = 0;
  80     ctr->c.ldv.not_used = 0;
  81     ctr->c.ldv.used = 0;
  82     ctr->c.ldv.void_total = 0;
  83     ctr->c.ldv.drag_total = 0;
  84 }
  85
  86 typedef struct {
  87     double      time;    // the time in MUT time when the census is made
  88     HashTable * hash;
  89     counter   * ctrs;
  90     Arena     * arena;
  91
  92     // for LDV profiling, when just displaying by LDV
  93     int       prim;
  94     int       not_used;
  95     int       used;
  96     int       void_total;
  97     int       drag_total;
  98 } Census;
  99
 100 Census *censuses = NULL;
 101 nat n_censuses = 0;
 102
 103 #ifdef PROFILING
 104 static void aggregateCensusInfo( void );
 105 #endif
 106
 107 static void dumpCensus( Census *census );
 108
 109 /* -----------------------------------------------------------------------------
 110    Closure Type Profiling;
 111
 112    PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
 113    -------------------------------------------------------------------------- */
 114
 115 #ifdef DEBUG_HEAP_PROF
 116 static char *type_names[] = {
 117       "INVALID_OBJECT"
 118     , "CONSTR"
 119     , "CONSTR_INTLIKE"
 120     , "CONSTR_CHARLIKE"
 121     , "CONSTR_STATIC"
 122     , "CONSTR_NOCAF_STATIC"
 123
 124     , "FUN"
 125     , "FUN_STATIC"
 126
 127     , "THUNK"
 128     , "THUNK_STATIC"
 129     , "THUNK_SELECTOR"
 130
 131     , "BCO"
 132     , "AP_UPD"
 133
 134     , "PAP"
 135
 136     , "IND"
 137     , "IND_OLDGEN"
 138     , "IND_PERM"
 139     , "IND_OLDGEN_PERM"
 140     , "IND_STATIC"
 141
 142     , "RET_BCO"
 143     , "RET_SMALL"
 144     , "RET_VEC_SMALL"
 145     , "RET_BIG"
 146     , "RET_VEC_BIG"
 147     , "RET_DYN"
 148     , "UPDATE_FRAME"
 149     , "CATCH_FRAME"
 150     , "STOP_FRAME"
 151     , "SEQ_FRAME"
 152
 153     , "BLACKHOLE"
 154     , "BLACKHOLE_BQ"
 155     , "MVAR"
 156
 157     , "ARR_WORDS"
 158
 159     , "MUT_ARR_PTRS"
 160     , "MUT_ARR_PTRS_FROZEN"
 161     , "MUT_VAR"
 162
 163     , "WEAK"
 164     , "FOREIGN"
 165
 166     , "TSO"
 167
 168     , "BLOCKED_FETCH"
 169     , "FETCH_ME"
 170
 171     , "EVACUATED"
 172 };
 173
 174 #endif /* DEBUG_HEAP_PROF */
 175
 176 /* -----------------------------------------------------------------------------
 177  * Find the "closure identity", which is a unique pointer reresenting
 178  * the band to which this closure's heap space is attributed in the
 179  * heap profile.
 180  * ------------------------------------------------------------------------- */
 181 static inline void *
 182 closureIdentity( StgClosure *p )
 183 {
 184     switch (RtsFlags.ProfFlags.doHeapProfile) {
 185
 186 #ifdef PROFILING
 187     case HEAP_BY_CCS:
 188         return ((StgClosure *)p)->header.prof.ccs;
 189     case HEAP_BY_MOD:
 190         return ((StgClosure *)p)->header.prof.ccs->cc->module;
 191     case HEAP_BY_DESCR:
 192         return (get_itbl((StgClosure *)p))->prof.closure_desc;
 193     case HEAP_BY_TYPE:
 194         return (get_itbl((StgClosure *)p))->prof.closure_type;
 195     case HEAP_BY_RETAINER:
 196         return retainerSetOf((StgClosure *)p);
 197 #else // DEBUG
 198     case HEAP_BY_INFOPTR:
 199         return (void *)((StgClosure *)p)->header.info;
 200     case HEAP_BY_CLOSURE_TYPE:
 201         return type_names[get_itbl(p)->type];
 202 #endif
 203     default:
 204         barf("closureIdentity");
 205     }
 206 }
 207
 208 /* --------------------------------------------------------------------------
 209  * Profiling type predicates
 210  * ----------------------------------------------------------------------- */
 211 #ifdef PROFILING
 212 static inline rtsBool
 213 doingLDVProfiling( void )
 214 {
 215     return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
 216             || RtsFlags.ProfFlags.bioSelector != NULL);
 217 }
 218
 219 static inline rtsBool
 220 doingRetainerProfiling( void )
 221 {
 222     return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
 223             || RtsFlags.ProfFlags.retainerSelector != NULL);
 224 }
 225 #endif // PROFILING
 226
 227 // Precesses a closure 'c' being destroyed whose size is 'size'.
 228 // Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
 229 // such as TSO; they should not be involved in computing dragNew or voidNew.
 230 //
 231 // Even though era is checked in both LdvCensusForDead() and
 232 // LdvCensusKillAll(), we still need to make sure that era is > 0 because
 233 // LDV_recordDead() may be called from elsewhere in the runtime system. E.g.,
 234 // when a thunk is replaced by an indirection object.
 235
 236 #ifdef PROFILING
 237 void
 238 LDV_recordDead( StgClosure *c, nat size )
 239 {
 240     void *id;
 241     nat t;
 242     counter *ctr;
 243
 244     if (era > 0 && closureSatisfiesConstraints(c)) {
 245         size -= sizeofW(StgProfHeader);
 246         if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
 247             t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
 248             if (t < era) {
 249                 if (RtsFlags.ProfFlags.bioSelector == NULL) {
 250                     censuses[t].void_total   += (int)size;
 251                     censuses[era].void_total -= (int)size;
 252                 } else {
 253                     id = closureIdentity(c);
 254                     ctr = lookupHashTable(censuses[t].hash, (StgWord)id);
 255                     ASSERT( ctr != NULL );
 256                     ctr->c.ldv.void_total += (int)size;
 257                     ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
 258                     if (ctr == NULL) {
 259                         ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
 260                         initLDVCtr(ctr);
 261                         insertHashTable(censuses[era].hash, (StgWord)id, ctr);
 262                         ctr->identity = id;
 263                         ctr->next = censuses[era].ctrs;
 264                         censuses[era].ctrs = ctr;
 265                     }
 266                     ctr->c.ldv.void_total -= (int)size;
 267                 }
 268             }
 269         } else {
 270             t = LDVW((c)) & LDV_LAST_MASK;
 271             if (t + 1 < era) {
 272                 if (RtsFlags.ProfFlags.bioSelector == NULL) {
 273                     censuses[t+1].drag_total += size;
 274                     censuses[era].drag_total -= size;
 275                 } else {
 276                     void *id;
 277                     id = closureIdentity(c);
 278                     ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
 279                     ASSERT( ctr != NULL );
 280                     ctr->c.ldv.drag_total += (int)size;
 281                     ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
 282                     if (ctr == NULL) {
 283                         ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
 284                         initLDVCtr(ctr);
 285                         insertHashTable(censuses[era].hash, (StgWord)id, ctr);
 286                         ctr->identity = id;
 287                         ctr->next = censuses[era].ctrs;
 288                         censuses[era].ctrs = ctr;
 289                     }
 290                     ctr->c.ldv.drag_total -= (int)size;
 291                 }
 292             }
 293         }
 294     }
 295 }
 296 #endif
 297
 298 /* --------------------------------------------------------------------------
 299  * Initialize censuses[era];
 300  * ----------------------------------------------------------------------- */
 301 static inline void
 302 initEra(Census *census)
 303 {
 304     census->hash  = allocHashTable();
 305     census->ctrs  = NULL;
 306     census->arena = newArena();
 307
 308     census->not_used   = 0;
 309     census->used       = 0;
 310     census->prim       = 0;
 311     census->void_total = 0;
 312     census->drag_total = 0;
 313 }
 314
 315 /* --------------------------------------------------------------------------
 316  * Increases era by 1 and initialize census[era].
 317  * Reallocates gi[] and increases its size if needed.
 318  * ----------------------------------------------------------------------- */
 319 static void
 320 nextEra( void )
 321 {
 322 #ifdef PROFILING
 323     if (doingLDVProfiling()) {
 324         era++;
 325
 326         if (era == max_era) {
 327             barf("maximum number of censuses reached; use +RTS -i to reduce");
 328         }
 329
 330         if (era == n_censuses) {
 331             n_censuses *= 2;
 332             censuses = stgReallocBytes(censuses, sizeof(Census) * n_censuses,
 333                                        "nextEra");
 334         }
 335     }
 336 #endif // PROFILING
 337
 338     initEra( &censuses[era] );
 339 }
 340
 341 /* -------------------------------------------------------------------------- */
 342
 343 #ifdef DEBUG_HEAP_PROF
 344 FILE *hp_file;
 345
 346 void initProfiling1( void )
 347 {
 348 }
 349
 350 void initProfiling2( void )
 351 {
 352   initHeapProfiling();
 353 }
 354
 355 void endProfiling( void )
 356 {
 357   endHeapProfiling();
 358 }
 359 #endif /* DEBUG_HEAP_PROF */
 360
 361 nat
 362 initHeapProfiling(void)
 363 {
 364     if (! RtsFlags.ProfFlags.doHeapProfile) {
 365         return 0;
 366     }
 367
 368     // we only count eras if we're doing LDV profiling.  Otherwise era
 369     // is fixed at zero.
 370 #ifdef PROFILING
 371     if (doingLDVProfiling()) {
 372         era = 1;
 373     } else
 374 #endif
 375     {
 376         era = 0;
 377     }
 378
 379     {   // max_era = 2^LDV_SHIFT
 380         nat p;
 381         max_era = 1;
 382         for (p = 0; p < LDV_SHIFT; p++)
 383             max_era *= 2;
 384     }
 385
 386     n_censuses = 32;
 387     censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");
 388
 389     initEra( &censuses[era] );
 390
 391     fprintf(hp_file, "JOB \"%s", prog_argv[0]);
 392
 393 #ifdef PROFILING
 394     {
 395         int count;
 396         for(count = 1; count < prog_argc; count++)
 397             fprintf(hp_file, " %s", prog_argv[count]);
 398         fprintf(hp_file, " +RTS ");
 399         for(count = 0; count < rts_argc; count++)
 400             fprintf(hp_file, "%s ", rts_argv[count]);
 401         fprintf(hp_file, "\n");
 402     }
 403 #endif /* PROFILING */
 404
 405     fprintf(hp_file, "\"\n" );
 406
 407     fprintf(hp_file, "DATE \"%s\"\n", time_str());
 408
 409     fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
 410     fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
 411
 412     fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
 413     fprintf(hp_file, "END_SAMPLE 0.00\n");
 414
 415 #ifdef DEBUG_HEAP_PROF
 416     DEBUG_LoadSymbols(prog_argv[0]);
 417 #endif
 418
 419 #ifdef PROFILING
 420     if (doingRetainerProfiling()) {
 421         initRetainerProfiling();
 422     }
 423 #endif
 424
 425     return 0;
 426 }
 427
 428 void
 429 endHeapProfiling(void)
 430 {
 431     StgDouble seconds;
 432
 433     if (! RtsFlags.ProfFlags.doHeapProfile) {
 434         return;
 435     }
 436
 437 #ifdef PROFILING
 438     if (doingRetainerProfiling()) {
 439         endRetainerProfiling();
 440     }
 441 #endif
 442
 443 #ifdef PROFILING
 444   // Note:
 445   //   We do not need to perform a major garbage collection because all the
 446   //   closures created since the last census will not affect the profiling
 447   //   statistics anyhow.
 448   if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV)
 449     LdvCensusKillAll();
 450 #endif
 451
 452 #ifdef PROFILING
 453     if (RtsFlags.ProfFlags.bioSelector != NULL) {
 454         nat t;
 455         aggregateCensusInfo();
 456         for (t = 1; t < era; t++) {
 457             dumpCensus( &censuses[t] );
 458         }
 459     }
 460 #endif
 461
 462     seconds = mut_user_time();
 463     fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 464     fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
 465     fclose(hp_file);
 466 }
 467
 468
 469
 470 #ifdef PROFILING
 471 static void
 472 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
 473 {
 474     char buf[max_length+1];
 475     nat next_offset = 0;
 476     nat written;
 477     char *template;
 478
 479     // MAIN on its own gets printed as "MAIN", otherwise we ignore MAIN.
 480     if (ccs == CCS_MAIN) {
 481         fprintf(fp, "MAIN");
 482         return;
 483     }
 484
 485     // keep printing components of the stack until we run out of space
 486     // in the buffer.  If we run out of space, end with "...".
 487     for (; ccs != NULL && ccs != CCS_MAIN; ccs = ccs->prevStack) {
 488
 489         // CAF cost centres print as M.CAF, but we leave the module
 490         // name out of all the others to save space.
 491         if (!strcmp(ccs->cc->label,"CAF")) {
 492             written = snprintf(buf+next_offset,
 493                                (int)max_length-3-(int)next_offset,
 494                                "%s.CAF", ccs->cc->module);
 495         } else {
 496             if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
 497                 template = "%s/";
 498             } else {
 499                 template = "%s";
 500             }
 501             written = snprintf(buf+next_offset,
 502                                (int)max_length-3-(int)next_offset,
 503                                template, ccs->cc->label);
 504         }
 505
 506         if (next_offset+written >= max_length-4) {
 507             sprintf(buf+max_length-4, "...");
 508             break;
 509         } else {
 510             next_offset += written;
 511         }
 512     }
 513     fprintf(fp, "%s", buf);
 514 }
 515
 516 static rtsBool
 517 str_matches_selector( char* str, char* sel )
 518 {
 519    char* p;
 520    // fprintf(stderr, "str_matches_selector %s %s\n", str, sel);
 521    while (1) {
 522        // Compare str against wherever we've got to in sel.
 523        p = str;
 524        while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
 525            p++; sel++;
 526        }
 527        // Match if all of str used and have reached the end of a sel fragment.
 528        if (*p == '\0' && (*sel == ',' || *sel == '\0'))
 529            return rtsTrue;
 530
 531        // No match.  Advance sel to the start of the next elem.
 532        while (*sel != ',' && *sel != '\0') sel++;
 533        if (*sel == ',') sel++;
 534
 535        /* Run out of sel ?? */
 536        if (*sel == '\0') return rtsFalse;
 537    }
 538 }
 539
 540 // Figure out whether a closure should be counted in this census, by
 541 // testing against all the specified constraints.
 542 rtsBool
 543 closureSatisfiesConstraints( StgClosure* p )
 544 {
 545    rtsBool b;
 546    if (RtsFlags.ProfFlags.modSelector) {
 547        b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module,
 548                                  RtsFlags.ProfFlags.modSelector );
 549        if (!b) return rtsFalse;
 550    }
 551    if (RtsFlags.ProfFlags.descrSelector) {
 552        b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_desc,
 553                                  RtsFlags.ProfFlags.descrSelector );
 554        if (!b) return rtsFalse;
 555    }
 556    if (RtsFlags.ProfFlags.typeSelector) {
 557        b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_type,
 558                                 RtsFlags.ProfFlags.typeSelector );
 559        if (!b) return rtsFalse;
 560    }
 561    if (RtsFlags.ProfFlags.ccSelector) {
 562        b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->label,
 563                                  RtsFlags.ProfFlags.ccSelector );
 564        if (!b) return rtsFalse;
 565    }
 566    if (RtsFlags.ProfFlags.retainerSelector) {
 567        RetainerSet *rs;
 568        nat i;
 569        rs = retainerSetOf((StgClosure *)p);
 570        if (rs != NULL) {
 571            for (i = 0; i < rs->num; i++) {
 572                b = str_matches_selector( rs->element[i]->cc->label,
 573                                          RtsFlags.ProfFlags.retainerSelector );
 574                if (b) return rtsTrue;
 575            }
 576        }
 577        return rtsFalse;
 578    }
 579    return rtsTrue;
 580 }
 581 #endif /* PROFILING */
 582
 583 /* -----------------------------------------------------------------------------
 584  * Aggregate the heap census info for biographical profiling
 585  * -------------------------------------------------------------------------- */
 586 #ifdef PROFILING
 587 static void
 588 aggregateCensusInfo( void )
 589 {
 590     HashTable *acc;
 591     nat t;
 592     counter *c, *d, *ctrs;
 593     Arena *arena;
 594
 595     if (!doingLDVProfiling()) return;
 596
 597     // Aggregate the LDV counters when displaying by biography.
 598     if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
 599         int void_total, drag_total;
 600
 601         // Now we compute void_total and drag_total for each census
 602         void_total = 0;
 603         drag_total = 0;
 604         for (t = 1; t < era; t++) { // note: start at 1, not 0
 605             void_total += censuses[t].void_total;
 606             drag_total += censuses[t].drag_total;
 607             censuses[t].void_total = void_total;
 608             censuses[t].drag_total = drag_total;
 609             ASSERT( censuses[t].void_total < censuses[t].not_used );
 610             ASSERT( censuses[t].drag_total < censuses[t].used );
 611         }
 612
 613         for (t = 1; t < era; t++) { // note: start at 1, not 0
 614             fprintf(hp_file, "MARK %f\n", censuses[t].time);
 615             fprintf(hp_file, "BEGIN_SAMPLE %f\n", censuses[t].time);
 616             fprintf(hp_file, "VOID\t%u\n", censuses[t].void_total * sizeof(W_));
 617             fprintf(hp_file, "LAG\t%u\n",
 618                     (censuses[t].not_used - censuses[t].void_total)
 619                     * sizeof(W_));
 620             fprintf(hp_file, "USE\t%u\n",
 621                     (censuses[t].used - censuses[t].drag_total) * sizeof(W_));
 622             fprintf(hp_file, "INHERENT_USE\t%u\n",
 623                     censuses[t].prim * sizeof(W_));
 624             fprintf(hp_file, "DRAG\t%u\n", censuses[t].drag_total * sizeof(W_));
 625             fprintf(hp_file, "END_SAMPLE %f\n", censuses[t].time);
 626         }
 627
 628         return;
 629     }
 630
 631     // otherwise... we're doing a heap profile that is restricted to
 632     // some combination of lag, drag, void or use.  We've kept all the
 633     // census info for all censuses so far, but we still need to
 634     // aggregate the counters forwards.
 635
 636     arena = newArena();
 637     acc = allocHashTable();
 638     ctrs = NULL;
 639
 640     for (t = 1; t < era; t++) {
 641
 642         // first look through all the counters we're aggregating
 643         for (c = ctrs; c != NULL; c = c->next) {
 644             // if one of the totals is non-zero, then this closure
 645             // type must be present in the heap at this census time...
 646             d = lookupHashTable(censuses[t].hash, (StgWord)c->identity);
 647
 648             if (d == NULL) {
 649                 // if this closure identity isn't present in the
 650                 // census for this time period, then our running
 651                 // totals *must* be zero.
 652                 ASSERT(c->c.ldv.void_total == 0 && c->c.ldv.drag_total == 0);
 653
 654                 // fprintCCS(stderr,c->identity);
 655                 // fprintf(stderr," census=%d void_total=%d drag_total=%d\n",
 656                 //         t, c->c.ldv.void_total, c->c.ldv.drag_total);
 657             } else {
 658                 d->c.ldv.void_total += c->c.ldv.void_total;
 659                 d->c.ldv.drag_total += c->c.ldv.drag_total;
 660                 c->c.ldv.void_total =  d->c.ldv.void_total;
 661                 c->c.ldv.drag_total =  d->c.ldv.drag_total;
 662
 663                 ASSERT( c->c.ldv.void_total >= 0 );
 664                 ASSERT( c->c.ldv.drag_total >= 0 );
 665             }
 666         }
 667
 668         // now look through the counters in this census to find new ones
 669         for (c = censuses[t].ctrs; c != NULL; c = c->next) {
 670             d = lookupHashTable(acc, (StgWord)c->identity);
 671             if (d == NULL) {
 672                 d = arenaAlloc( arena, sizeof(counter) );
 673                 initLDVCtr(d);
 674                 insertHashTable( acc, (StgWord)c->identity, d );
 675                 d->identity = c->identity;
 676                 d->next = ctrs;
 677                 ctrs = d;
 678                 d->c.ldv.void_total = c->c.ldv.void_total;
 679                 d->c.ldv.drag_total = c->c.ldv.drag_total;
 680             }
 681             ASSERT( c->c.ldv.void_total >= 0 );
 682             ASSERT( c->c.ldv.drag_total >= 0 );
 683         }
 684     }
 685
 686     freeHashTable(acc, NULL);
 687     arenaFree(arena);
 688 }
 689 #endif
 690
 691 /* -----------------------------------------------------------------------------
 692  * Print out the results of a heap census.
 693  * -------------------------------------------------------------------------- */
 694 static void
 695 dumpCensus( Census *census )
 696 {
 697     counter *ctr;
 698     int count;
 699
 700     fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", census->time);
 701
 702     for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
 703
 704 #ifdef PROFILING
 705         if (RtsFlags.ProfFlags.bioSelector != NULL) {
 706             count = 0;
 707             if (str_matches_selector("lag", RtsFlags.ProfFlags.bioSelector))
 708                 count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
 709             if (str_matches_selector("drag", RtsFlags.ProfFlags.bioSelector))
 710                 count += ctr->c.ldv.drag_total;
 711             if (str_matches_selector("void", RtsFlags.ProfFlags.bioSelector))
 712                 count += ctr->c.ldv.void_total;
 713             if (str_matches_selector("use", RtsFlags.ProfFlags.bioSelector))
 714                 count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
 715         } else
 716 #endif
 717         {
 718             count = ctr->c.resid;
 719         }
 720
 721         ASSERT( count >= 0 );
 722
 723         if (count == 0) continue;
 724
 725 #ifdef DEBUG_HEAP_PROF
 726         switch (RtsFlags.ProfFlags.doHeapProfile) {
 727         case HEAP_BY_INFOPTR:
 728             fprint_data(hp_file);
 729             break;
 730         case HEAP_BY_CLOSURE_TYPE:
 731             fprint_closure_types(hp_file);
 732             break;
 733         }
 734 #endif
 735
 736 #ifdef PROFILING
 737         switch (RtsFlags.ProfFlags.doHeapProfile) {
 738         case HEAP_BY_CCS:
 739             fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, 30);
 740             break;
 741         case HEAP_BY_MOD:
 742         case HEAP_BY_DESCR:
 743         case HEAP_BY_TYPE:
 744             fprintf(hp_file, "%s", (char *)ctr->identity);
 745             break;
 746         case HEAP_BY_RETAINER:
 747         {
 748             RetainerSet *rs = (RetainerSet *)ctr->identity;
 749
 750             // it might be the distinguished retainer set rs_MANY:
 751             if (rs == &rs_MANY) {
 752                 fprintf(hp_file, "MANY");
 753                 break;
 754             }
 755
 756             // Mark this retainer set by negating its id, because it
 757             // has appeared in at least one census.  We print the
 758             // values of all such retainer sets into the log file at
 759             // the end.  A retainer set may exist but not feature in
 760             // any censuses if it arose as the intermediate retainer
 761             // set for some closure during retainer set calculation.
 762             if (rs->id > 0)
 763                 rs->id = -(rs->id);
 764
 765             // report in the unit of bytes: * sizeof(StgWord)
 766             printRetainerSetShort(hp_file, rs);
 767             break;
 768         }
 769         default:
 770             barf("dumpCensus; doHeapProfile");
 771         }
 772 #endif
 773
 774         fprintf(hp_file, "\t%d\n", count * sizeof(W_));
 775     }
 776
 777     fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
 778 }
 779
 780 /* -----------------------------------------------------------------------------
 781  * Code to perform a heap census.
 782  * -------------------------------------------------------------------------- */
 783 static void
 784 heapCensusChain( Census *census, bdescr *bd )
 785 {
 786     StgPtr p;
 787     StgInfoTable *info;
 788     void *identity;
 789     nat size;
 790     counter *ctr;
 791     nat real_size;
 792     rtsBool prim;
 793
 794     for (; bd != NULL; bd = bd->link) {
 795         p = bd->start;
 796         while (p < bd->free) {
 797             info = get_itbl((StgClosure *)p);
 798             prim = rtsFalse;
 799
 800             switch (info->type) {
 801
 802             case CONSTR:
 803             case FUN:
 804             case THUNK:
 805             case IND_PERM:
 806             case IND_OLDGEN_PERM:
 807             case CAF_BLACKHOLE:
 808             case SE_CAF_BLACKHOLE:
 809             case SE_BLACKHOLE:
 810             case BLACKHOLE:
 811             case BLACKHOLE_BQ:
 812             case CONSTR_INTLIKE:
 813             case CONSTR_CHARLIKE:
 814             case FUN_1_0:
 815             case FUN_0_1:
 816             case FUN_1_1:
 817             case FUN_0_2:
 818             case FUN_2_0:
 819             case THUNK_1_1:
 820             case THUNK_0_2:
 821             case THUNK_2_0:
 822             case CONSTR_1_0:
 823             case CONSTR_0_1:
 824             case CONSTR_1_1:
 825             case CONSTR_0_2:
 826             case CONSTR_2_0:
 827                 size = sizeW_fromITBL(info);
 828                 break;
 829
 830             case BCO:
 831             case MVAR:
 832             case WEAK:
 833             case FOREIGN:
 834             case STABLE_NAME:
 835             case MUT_VAR:
 836             case MUT_CONS:
 837                 prim = rtsTrue;
 838                 size = sizeW_fromITBL(info);
 839                 break;
 840
 841             case THUNK_1_0:             /* ToDo - shouldn't be here */
 842             case THUNK_0_1:             /* "  ditto  " */
 843             case THUNK_SELECTOR:
 844                 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 845                 break;
 846
 847             case PAP:
 848             case AP_UPD:
 849                 size = pap_sizeW((StgPAP *)p);
 850                 break;
 851
 852             case ARR_WORDS:
 853                 prim = rtsTrue;
 854                 size = arr_words_sizeW(stgCast(StgArrWords*,p));
 855                 break;
 856
 857             case MUT_ARR_PTRS:
 858             case MUT_ARR_PTRS_FROZEN:
 859                 prim = rtsTrue;
 860                 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 861                 break;
 862
 863             case TSO:
 864                 prim = rtsTrue;
 865                 size = tso_sizeW((StgTSO *)p);
 866                 break;
 867
 868             default:
 869                 barf("heapCensus");
 870             }
 871
 872             identity = NULL;
 873
 874 #ifdef DEBUG_HEAP_PROF
 875             real_size = size;
 876 #else
 877             // subtract the profiling overhead
 878             real_size = size - sizeofW(StgProfHeader);
 879 #endif
 880
 881             if (closureSatisfiesConstraints((StgClosure*)p)) {
 882 #ifdef PROFILING
 883                 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
 884                     if (prim)
 885                         census->prim += real_size;
 886                     else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
 887                         census->not_used += real_size;
 888                     else
 889                         census->used += real_size;
 890                 } else
 891 #endif
 892                 {
 893                     identity = closureIdentity((StgClosure *)p);
 894
 895                     if (identity != NULL) {
 896                         ctr = lookupHashTable( census->hash, (StgWord)identity );
 897                         if (ctr != NULL) {
 898 #ifdef PROFILING
 899                             if (RtsFlags.ProfFlags.bioSelector != NULL) {
 900                                 if (prim)
 901                                     ctr->c.ldv.prim += real_size;
 902                                 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
 903                                     ctr->c.ldv.not_used += real_size;
 904                                 else
 905                                     ctr->c.ldv.used += real_size;
 906                             } else
 907 #endif
 908                             {
 909                                 ctr->c.resid += real_size;
 910                             }
 911                         } else {
 912                             ctr = arenaAlloc( census->arena, sizeof(counter) );
 913                             initLDVCtr(ctr);
 914                             insertHashTable( census->hash, (StgWord)identity, ctr );
 915                             ctr->identity = identity;
 916                             ctr->next = census->ctrs;
 917                             census->ctrs = ctr;
 918
 919 #ifdef PROFILING
 920                             if (RtsFlags.ProfFlags.bioSelector != NULL) {
 921                                 if (prim)
 922                                     ctr->c.ldv.prim = real_size;
 923                                 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
 924                                     ctr->c.ldv.not_used = real_size;
 925                                 else
 926                                     ctr->c.ldv.used = real_size;
 927                             } else
 928 #endif
 929                             {
 930                                 ctr->c.resid = real_size;
 931                             }
 932                         }
 933                     }
 934                 }
 935             }
 936
 937             p += size;
 938         }
 939     }
 940 }
 941
 942 void
 943 heapCensus( void )
 944 {
 945   nat g, s;
 946   Census *census;
 947
 948   census = &censuses[era];
 949   census->time  = mut_user_time();
 950
 951   // calculate retainer sets if necessary
 952 #ifdef PROFILING
 953   if (doingRetainerProfiling()) {
 954       retainerProfile();
 955   }
 956 #endif
 957
 958   stat_startHeapCensus();
 959
 960   // traverse the heap, collecting the census info
 961   heapCensusChain( census, small_alloc_list );
 962   if (RtsFlags.GcFlags.generations == 1) {
 963       heapCensusChain( census, g0s0->to_blocks );
 964   } else {
 965       for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 966           for (s = 0; s < generations[g].n_steps; s++) {
 967               heapCensusChain( census, generations[g].steps[s].blocks );
 968               // Are we interested in large objects?  might be
 969               // confusing to include the stack in a heap profile.
 970               // heapCensusChain( census, generations[g].steps[s].large_objects );
 971           }
 972       }
 973   }
 974
 975   // dump out the census info
 976 #ifdef PROFILING
 977     // We can't generate any info for LDV profiling until
 978     // the end of the run...
 979     if (!doingLDVProfiling())
 980         dumpCensus( census );
 981 #else
 982     dumpCensus( census );
 983 #endif
 984
 985
 986   // free our storage, unless we're keeping all the census info for
 987   // future restriction by biography.
 988 #ifdef PROFILING
 989   if (RtsFlags.ProfFlags.bioSelector == NULL)
 990 #endif
 991   {
 992       freeHashTable( census->hash, NULL/* don't free the elements */ );
 993       arenaFree( census->arena );
 994       census->hash = NULL;
 995       census->arena = NULL;
 996   }
 997
 998   // we're into the next time period now
 999   nextEra();
1000
1001   stat_endHeapCensus();
1002 }
1003
1004 #endif /* PROFILING || DEBUG_HEAP_PROF */
1005