rts/ProfHeap.c

   1 /* ----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2003
   4  *
   5  * Support for heap profiling
   6  *
   7  * --------------------------------------------------------------------------*/
   8
   9 #include "PosixSource.h"
  10 #include "Rts.h"
  11
  12 #include "RtsUtils.h"
  13 #include "Profiling.h"
  14 #include "ProfHeap.h"
  15 #include "Stats.h"
  16 #include "Hash.h"
  17 #include "RetainerProfile.h"
  18 #include "LdvProfile.h"
  19 #include "Arena.h"
  20 #include "Printer.h"
  21
  22 #include <string.h>
  23
  24 /* -----------------------------------------------------------------------------
  25  * era stores the current time period.  It is the same as the
  26  * number of censuses that have been performed.
  27  *
  28  * RESTRICTION:
  29  *   era must be no longer than LDV_SHIFT (15 or 30) bits.
  30  * Invariants:
  31  *   era is initialized to 1 in initHeapProfiling().
  32  *
  33  * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling().
  34  * When era reaches max_era, the profiling stops because a closure can
  35  * store only up to (max_era - 1) as its creation or last use time.
  36  * -------------------------------------------------------------------------- */
  37 unsigned int era;
  38 static nat max_era;
  39
  40 /* -----------------------------------------------------------------------------
  41  * Counters
  42  *
  43  * For most heap profiles each closure identity gets a simple count
  44  * of live words in the heap at each census.  However, if we're
  45  * selecting by biography, then we have to keep the various
  46  * lag/drag/void counters for each identity.
  47  * -------------------------------------------------------------------------- */
  48 typedef struct _counter {
  49     void *identity;
  50     union {
  51         nat resid;
  52         struct {
  53             int prim;     // total size of 'inherently used' closures
  54             int not_used; // total size of 'never used' closures
  55             int used;     // total size of 'used at least once' closures
  56             int void_total;  // current total size of 'destroyed without being used' closures
  57             int drag_total;  // current total size of 'used at least once and waiting to die'
  58         } ldv;
  59     } c;
  60     struct _counter *next;
  61 } counter;
  62
  63 STATIC_INLINE void
  64 initLDVCtr( counter *ctr )
  65 {
  66     ctr->c.ldv.prim = 0;
  67     ctr->c.ldv.not_used = 0;
  68     ctr->c.ldv.used = 0;
  69     ctr->c.ldv.void_total = 0;
  70     ctr->c.ldv.drag_total = 0;
  71 }
  72
  73 typedef struct {
  74     double      time;    // the time in MUT time when the census is made
  75     HashTable * hash;
  76     counter   * ctrs;
  77     Arena     * arena;
  78
  79     // for LDV profiling, when just displaying by LDV
  80     int       prim;
  81     int       not_used;
  82     int       used;
  83     int       void_total;
  84     int       drag_total;
  85 } Census;
  86
  87 static Census *censuses = NULL;
  88 static nat n_censuses = 0;
  89
  90 #ifdef PROFILING
  91 static void aggregateCensusInfo( void );
  92 #endif
  93
  94 static void dumpCensus( Census *census );
  95
  96 static rtsBool closureSatisfiesConstraints( StgClosure* p );
  97
  98 /* ----------------------------------------------------------------------------
  99  * Find the "closure identity", which is a unique pointer reresenting
 100  * the band to which this closure's heap space is attributed in the
 101  * heap profile.
 102  * ------------------------------------------------------------------------- */
 103 static void *
 104 closureIdentity( StgClosure *p )
 105 {
 106     switch (RtsFlags.ProfFlags.doHeapProfile) {
 107
 108 #ifdef PROFILING
 109     case HEAP_BY_CCS:
 110         return p->header.prof.ccs;
 111     case HEAP_BY_MOD:
 112         return p->header.prof.ccs->cc->module;
 113     case HEAP_BY_DESCR:
 114         return GET_PROF_DESC(get_itbl(p));
 115     case HEAP_BY_TYPE:
 116         return GET_PROF_TYPE(get_itbl(p));
 117     case HEAP_BY_RETAINER:
 118         // AFAIK, the only closures in the heap which might not have a
 119         // valid retainer set are DEAD_WEAK closures.
 120         if (isRetainerSetFieldValid(p))
 121             return retainerSetOf(p);
 122         else
 123             return NULL;
 124
 125 #else
 126     case HEAP_BY_CLOSURE_TYPE:
 127     {
 128         StgInfoTable *info;
 129         info = get_itbl(p);
 130         switch (info->type) {
 131         case CONSTR:
 132         case CONSTR_1_0:
 133         case CONSTR_0_1:
 134         case CONSTR_2_0:
 135         case CONSTR_1_1:
 136         case CONSTR_0_2:
 137         case CONSTR_STATIC:
 138         case CONSTR_NOCAF_STATIC:
 139             return GET_CON_DESC(itbl_to_con_itbl(info));
 140         default:
 141             return closure_type_names[info->type];
 142         }
 143     }
 144
 145 #endif
 146     default:
 147         barf("closureIdentity");
 148     }
 149 }
 150
 151 /* --------------------------------------------------------------------------
 152  * Profiling type predicates
 153  * ----------------------------------------------------------------------- */
 154 #ifdef PROFILING
 155 STATIC_INLINE rtsBool
 156 doingLDVProfiling( void )
 157 {
 158     return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
 159             || RtsFlags.ProfFlags.bioSelector != NULL);
 160 }
 161
 162 STATIC_INLINE rtsBool
 163 doingRetainerProfiling( void )
 164 {
 165     return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
 166             || RtsFlags.ProfFlags.retainerSelector != NULL);
 167 }
 168 #endif /* PROFILING */
 169
 170 // Precesses a closure 'c' being destroyed whose size is 'size'.
 171 // Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
 172 // such as TSO; they should not be involved in computing dragNew or voidNew.
 173 //
 174 // Even though era is checked in both LdvCensusForDead() and
 175 // LdvCensusKillAll(), we still need to make sure that era is > 0 because
 176 // LDV_recordDead() may be called from elsewhere in the runtime system. E.g.,
 177 // when a thunk is replaced by an indirection object.
 178
 179 #ifdef PROFILING
 180 void
 181 LDV_recordDead( StgClosure *c, nat size )
 182 {
 183     void *id;
 184     nat t;
 185     counter *ctr;
 186
 187     if (era > 0 && closureSatisfiesConstraints(c)) {
 188         size -= sizeofW(StgProfHeader);
 189         ASSERT(LDVW(c) != 0);
 190         if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
 191             t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
 192             if (t < era) {
 193                 if (RtsFlags.ProfFlags.bioSelector == NULL) {
 194                     censuses[t].void_total   += (int)size;
 195                     censuses[era].void_total -= (int)size;
 196                     ASSERT(censuses[t].void_total < censuses[t].not_used);
 197                 } else {
 198                     id = closureIdentity(c);
 199                     ctr = lookupHashTable(censuses[t].hash, (StgWord)id);
 200                     ASSERT( ctr != NULL );
 201                     ctr->c.ldv.void_total += (int)size;
 202                     ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
 203                     if (ctr == NULL) {
 204                         ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
 205                         initLDVCtr(ctr);
 206                         insertHashTable(censuses[era].hash, (StgWord)id, ctr);
 207                         ctr->identity = id;
 208                         ctr->next = censuses[era].ctrs;
 209                         censuses[era].ctrs = ctr;
 210                     }
 211                     ctr->c.ldv.void_total -= (int)size;
 212                 }
 213             }
 214         } else {
 215             t = LDVW((c)) & LDV_LAST_MASK;
 216             if (t + 1 < era) {
 217                 if (RtsFlags.ProfFlags.bioSelector == NULL) {
 218                     censuses[t+1].drag_total += size;
 219                     censuses[era].drag_total -= size;
 220                 } else {
 221                     void *id;
 222                     id = closureIdentity(c);
 223                     ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
 224                     ASSERT( ctr != NULL );
 225                     ctr->c.ldv.drag_total += (int)size;
 226                     ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
 227                     if (ctr == NULL) {
 228                         ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
 229                         initLDVCtr(ctr);
 230                         insertHashTable(censuses[era].hash, (StgWord)id, ctr);
 231                         ctr->identity = id;
 232                         ctr->next = censuses[era].ctrs;
 233                         censuses[era].ctrs = ctr;
 234                     }
 235                     ctr->c.ldv.drag_total -= (int)size;
 236                 }
 237             }
 238         }
 239     }
 240 }
 241 #endif
 242
 243 /* --------------------------------------------------------------------------
 244  * Initialize censuses[era];
 245  * ----------------------------------------------------------------------- */
 246
 247 STATIC_INLINE void
 248 initEra(Census *census)
 249 {
 250     census->hash  = allocHashTable();
 251     census->ctrs  = NULL;
 252     census->arena = newArena();
 253
 254     census->not_used   = 0;
 255     census->used       = 0;
 256     census->prim       = 0;
 257     census->void_total = 0;
 258     census->drag_total = 0;
 259 }
 260
 261 STATIC_INLINE void
 262 freeEra(Census *census)
 263 {
 264     if (RtsFlags.ProfFlags.bioSelector != NULL)
 265         // when bioSelector==NULL, these are freed in heapCensus()
 266     {
 267         arenaFree(census->arena);
 268         freeHashTable(census->hash, NULL);
 269     }
 270 }
 271
 272 /* --------------------------------------------------------------------------
 273  * Increases era by 1 and initialize census[era].
 274  * Reallocates gi[] and increases its size if needed.
 275  * ----------------------------------------------------------------------- */
 276
 277 static void
 278 nextEra( void )
 279 {
 280 #ifdef PROFILING
 281     if (doingLDVProfiling()) {
 282         era++;
 283
 284         if (era == max_era) {
 285             errorBelch("maximum number of censuses reached; use +RTS -i to reduce");
 286             stg_exit(EXIT_FAILURE);
 287         }
 288
 289         if (era == n_censuses) {
 290             n_censuses *= 2;
 291             censuses = stgReallocBytes(censuses, sizeof(Census) * n_censuses,
 292                                        "nextEra");
 293         }
 294     }
 295 #endif /* PROFILING */
 296
 297     initEra( &censuses[era] );
 298 }
 299
 300 /* ----------------------------------------------------------------------------
 301  * Heap profiling by info table
 302  * ------------------------------------------------------------------------- */
 303
 304 #if !defined(PROFILING)
 305 FILE *hp_file;
 306 static char *hp_filename;
 307
 308 void initProfiling1 (void)
 309 {
 310 }
 311
 312 void freeProfiling1 (void)
 313 {
 314 }
 315
 316 void initProfiling2 (void)
 317 {
 318     char *prog;
 319
 320     prog = stgMallocBytes(strlen(prog_name) + 1, "initProfiling2");
 321     strcpy(prog, prog_name);
 322 #ifdef mingw32_HOST_OS
 323     // on Windows, drop the .exe suffix if there is one
 324     {
 325         char *suff;
 326         suff = strrchr(prog,'.');
 327         if (suff != NULL && !strcmp(suff,".exe")) {
 328             *suff = '\0';
 329         }
 330     }
 331 #endif
 332
 333   if (RtsFlags.ProfFlags.doHeapProfile) {
 334     /* Initialise the log file name */
 335     hp_filename = stgMallocBytes(strlen(prog) + 6, "hpFileName");
 336     sprintf(hp_filename, "%s.hp", prog);
 337
 338     /* open the log file */
 339     if ((hp_file = fopen(hp_filename, "w")) == NULL) {
 340       debugBelch("Can't open profiling report file %s\n",
 341               hp_filename);
 342       RtsFlags.ProfFlags.doHeapProfile = 0;
 343       return;
 344     }
 345   }
 346
 347   stgFree(prog);
 348
 349   initHeapProfiling();
 350 }
 351
 352 void endProfiling( void )
 353 {
 354   endHeapProfiling();
 355 }
 356 #endif /* !PROFILING */
 357
 358 static void
 359 printSample(rtsBool beginSample, StgDouble sampleValue)
 360 {
 361     StgDouble fractionalPart, integralPart;
 362     fractionalPart = modf(sampleValue, &integralPart);
 363     fprintf(hp_file, "%s %" FMT_Word64 ".%02" FMT_Word64 "\n",
 364             (beginSample ? "BEGIN_SAMPLE" : "END_SAMPLE"),
 365             (StgWord64)integralPart, (StgWord64)(fractionalPart * 100));
 366 }
 367
 368 /* --------------------------------------------------------------------------
 369  * Initialize the heap profilier
 370  * ----------------------------------------------------------------------- */
 371 nat
 372 initHeapProfiling(void)
 373 {
 374     if (! RtsFlags.ProfFlags.doHeapProfile) {
 375         return 0;
 376     }
 377
 378 #ifdef PROFILING
 379     if (doingLDVProfiling() && doingRetainerProfiling()) {
 380         errorBelch("cannot mix -hb and -hr");
 381         stg_exit(EXIT_FAILURE);
 382     }
 383 #endif
 384
 385     // we only count eras if we're doing LDV profiling.  Otherwise era
 386     // is fixed at zero.
 387 #ifdef PROFILING
 388     if (doingLDVProfiling()) {
 389         era = 1;
 390     } else
 391 #endif
 392     {
 393         era = 0;
 394     }
 395
 396     // max_era = 2^LDV_SHIFT
 397         max_era = 1 << LDV_SHIFT;
 398
 399     n_censuses = 32;
 400     censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");
 401
 402     initEra( &censuses[era] );
 403
 404     /* initProfilingLogFile(); */
 405     fprintf(hp_file, "JOB \"%s", prog_name);
 406
 407 #ifdef PROFILING
 408     {
 409         int count;
 410         for(count = 1; count < prog_argc; count++)
 411             fprintf(hp_file, " %s", prog_argv[count]);
 412         fprintf(hp_file, " +RTS");
 413         for(count = 0; count < rts_argc; count++)
 414             fprintf(hp_file, " %s", rts_argv[count]);
 415     }
 416 #endif /* PROFILING */
 417
 418     fprintf(hp_file, "\"\n" );
 419
 420     fprintf(hp_file, "DATE \"%s\"\n", time_str());
 421
 422     fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
 423     fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
 424
 425     printSample(rtsTrue, 0);
 426     printSample(rtsFalse, 0);
 427
 428 #ifdef PROFILING
 429     if (doingRetainerProfiling()) {
 430         initRetainerProfiling();
 431     }
 432 #endif
 433
 434     return 0;
 435 }
 436
 437 void
 438 endHeapProfiling(void)
 439 {
 440     StgDouble seconds;
 441
 442     if (! RtsFlags.ProfFlags.doHeapProfile) {
 443         return;
 444     }
 445
 446 #ifdef PROFILING
 447     if (doingRetainerProfiling()) {
 448         endRetainerProfiling();
 449     }
 450 #endif
 451
 452 #ifdef PROFILING
 453     if (doingLDVProfiling()) {
 454         nat t;
 455         LdvCensusKillAll();
 456         aggregateCensusInfo();
 457         for (t = 1; t < era; t++) {
 458             dumpCensus( &censuses[t] );
 459         }
 460     }
 461 #endif
 462
 463 #ifdef PROFILING
 464     if (doingLDVProfiling()) {
 465         nat t;
 466         for (t = 1; t <= era; t++) {
 467             freeEra( &censuses[t] );
 468         }
 469     } else {
 470         freeEra( &censuses[0] );
 471     }
 472 #else
 473     freeEra( &censuses[0] );
 474 #endif
 475
 476     stgFree(censuses);
 477
 478     seconds = mut_user_time();
 479     printSample(rtsTrue, seconds);
 480     printSample(rtsFalse, seconds);
 481     fclose(hp_file);
 482 }
 483
 484
 485
 486 #ifdef PROFILING
 487 static size_t
 488 buf_append(char *p, const char *q, char *end)
 489 {
 490     int m;
 491
 492     for (m = 0; p < end; p++, q++, m++) {
 493         *p = *q;
 494         if (*q == '\0') { break; }
 495     }
 496     return m;
 497 }
 498
 499 static void
 500 fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
 501 {
 502     char buf[max_length+1], *p, *buf_end;
 503
 504     // MAIN on its own gets printed as "MAIN", otherwise we ignore MAIN.
 505     if (ccs == CCS_MAIN) {
 506         fprintf(fp, "MAIN");
 507         return;
 508     }
 509
 510     fprintf(fp, "(%ld)", ccs->ccsID);
 511
 512     p = buf;
 513     buf_end = buf + max_length + 1;
 514
 515     // keep printing components of the stack until we run out of space
 516     // in the buffer.  If we run out of space, end with "...".
 517     for (; ccs != NULL && ccs != CCS_MAIN; ccs = ccs->prevStack) {
 518
 519         // CAF cost centres print as M.CAF, but we leave the module
 520         // name out of all the others to save space.
 521         if (!strcmp(ccs->cc->label,"CAF")) {
 522             p += buf_append(p, ccs->cc->module, buf_end);
 523             p += buf_append(p, ".CAF", buf_end);
 524         } else {
 525             p += buf_append(p, ccs->cc->label, buf_end);
 526             if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
 527                 p += buf_append(p, "/", buf_end);
 528             }
 529         }
 530
 531         if (p >= buf_end) {
 532             sprintf(buf+max_length-4, "...");
 533             break;
 534         }
 535     }
 536     fprintf(fp, "%s", buf);
 537 }
 538
 539 rtsBool
 540 strMatchesSelector( char* str, char* sel )
 541 {
 542    char* p;
 543    // debugBelch("str_matches_selector %s %s\n", str, sel);
 544    while (1) {
 545        // Compare str against wherever we've got to in sel.
 546        p = str;
 547        while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
 548            p++; sel++;
 549        }
 550        // Match if all of str used and have reached the end of a sel fragment.
 551        if (*p == '\0' && (*sel == ',' || *sel == '\0'))
 552            return rtsTrue;
 553
 554        // No match.  Advance sel to the start of the next elem.
 555        while (*sel != ',' && *sel != '\0') sel++;
 556        if (*sel == ',') sel++;
 557
 558        /* Run out of sel ?? */
 559        if (*sel == '\0') return rtsFalse;
 560    }
 561 }
 562
 563 #endif /* PROFILING */
 564
 565 /* -----------------------------------------------------------------------------
 566  * Figure out whether a closure should be counted in this census, by
 567  * testing against all the specified constraints.
 568  * -------------------------------------------------------------------------- */
 569 static rtsBool
 570 closureSatisfiesConstraints( StgClosure* p )
 571 {
 572 #if !defined(PROFILING)
 573     (void)p;   /* keep gcc -Wall happy */
 574     return rtsTrue;
 575 #else
 576    rtsBool b;
 577
 578    // The CCS has a selected field to indicate whether this closure is
 579    // deselected by not being mentioned in the module, CC, or CCS
 580    // selectors.
 581    if (!p->header.prof.ccs->selected) {
 582        return rtsFalse;
 583    }
 584
 585    if (RtsFlags.ProfFlags.descrSelector) {
 586        b = strMatchesSelector( (GET_PROF_DESC(get_itbl((StgClosure *)p))),
 587                                  RtsFlags.ProfFlags.descrSelector );
 588        if (!b) return rtsFalse;
 589    }
 590    if (RtsFlags.ProfFlags.typeSelector) {
 591        b = strMatchesSelector( (GET_PROF_TYPE(get_itbl((StgClosure *)p))),
 592                                 RtsFlags.ProfFlags.typeSelector );
 593        if (!b) return rtsFalse;
 594    }
 595    if (RtsFlags.ProfFlags.retainerSelector) {
 596        RetainerSet *rs;
 597        nat i;
 598        // We must check that the retainer set is valid here.  One
 599        // reason it might not be valid is if this closure is a
 600        // a newly deceased weak pointer (i.e. a DEAD_WEAK), since
 601        // these aren't reached by the retainer profiler's traversal.
 602        if (isRetainerSetFieldValid((StgClosure *)p)) {
 603            rs = retainerSetOf((StgClosure *)p);
 604            if (rs != NULL) {
 605                for (i = 0; i < rs->num; i++) {
 606                    b = strMatchesSelector( rs->element[i]->cc->label,
 607                                            RtsFlags.ProfFlags.retainerSelector );
 608                    if (b) return rtsTrue;
 609                }
 610            }
 611        }
 612        return rtsFalse;
 613    }
 614    return rtsTrue;
 615 #endif /* PROFILING */
 616 }
 617
 618 /* -----------------------------------------------------------------------------
 619  * Aggregate the heap census info for biographical profiling
 620  * -------------------------------------------------------------------------- */
 621 #ifdef PROFILING
 622 static void
 623 aggregateCensusInfo( void )
 624 {
 625     HashTable *acc;
 626     nat t;
 627     counter *c, *d, *ctrs;
 628     Arena *arena;
 629
 630     if (!doingLDVProfiling()) return;
 631
 632     // Aggregate the LDV counters when displaying by biography.
 633     if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
 634         int void_total, drag_total;
 635
 636         // Now we compute void_total and drag_total for each census
 637         // After the program has finished, the void_total field of
 638         // each census contains the count of words that were *created*
 639         // in this era and were eventually void.  Conversely, if a
 640         // void closure was destroyed in this era, it will be
 641         // represented by a negative count of words in void_total.
 642         //
 643         // To get the count of live words that are void at each
 644         // census, just propagate the void_total count forwards:
 645
 646         void_total = 0;
 647         drag_total = 0;
 648         for (t = 1; t < era; t++) { // note: start at 1, not 0
 649             void_total += censuses[t].void_total;
 650             drag_total += censuses[t].drag_total;
 651             censuses[t].void_total = void_total;
 652             censuses[t].drag_total = drag_total;
 653
 654             ASSERT( censuses[t].void_total <= censuses[t].not_used );
 655             // should be true because: void_total is the count of
 656             // live words that are void at this census, which *must*
 657             // be less than the number of live words that have not
 658             // been used yet.
 659
 660             ASSERT( censuses[t].drag_total <= censuses[t].used );
 661             // similar reasoning as above.
 662         }
 663
 664         return;
 665     }
 666
 667     // otherwise... we're doing a heap profile that is restricted to
 668     // some combination of lag, drag, void or use.  We've kept all the
 669     // census info for all censuses so far, but we still need to
 670     // aggregate the counters forwards.
 671
 672     arena = newArena();
 673     acc = allocHashTable();
 674     ctrs = NULL;
 675
 676     for (t = 1; t < era; t++) {
 677
 678         // first look through all the counters we're aggregating
 679         for (c = ctrs; c != NULL; c = c->next) {
 680             // if one of the totals is non-zero, then this closure
 681             // type must be present in the heap at this census time...
 682             d = lookupHashTable(censuses[t].hash, (StgWord)c->identity);
 683
 684             if (d == NULL) {
 685                 // if this closure identity isn't present in the
 686                 // census for this time period, then our running
 687                 // totals *must* be zero.
 688                 ASSERT(c->c.ldv.void_total == 0 && c->c.ldv.drag_total == 0);
 689
 690                 // debugCCS(c->identity);
 691                 // debugBelch(" census=%d void_total=%d drag_total=%d\n",
 692                 //         t, c->c.ldv.void_total, c->c.ldv.drag_total);
 693             } else {
 694                 d->c.ldv.void_total += c->c.ldv.void_total;
 695                 d->c.ldv.drag_total += c->c.ldv.drag_total;
 696                 c->c.ldv.void_total =  d->c.ldv.void_total;
 697                 c->c.ldv.drag_total =  d->c.ldv.drag_total;
 698
 699                 ASSERT( c->c.ldv.void_total >= 0 );
 700                 ASSERT( c->c.ldv.drag_total >= 0 );
 701             }
 702         }
 703
 704         // now look through the counters in this census to find new ones
 705         for (c = censuses[t].ctrs; c != NULL; c = c->next) {
 706             d = lookupHashTable(acc, (StgWord)c->identity);
 707             if (d == NULL) {
 708                 d = arenaAlloc( arena, sizeof(counter) );
 709                 initLDVCtr(d);
 710                 insertHashTable( acc, (StgWord)c->identity, d );
 711                 d->identity = c->identity;
 712                 d->next = ctrs;
 713                 ctrs = d;
 714                 d->c.ldv.void_total = c->c.ldv.void_total;
 715                 d->c.ldv.drag_total = c->c.ldv.drag_total;
 716             }
 717             ASSERT( c->c.ldv.void_total >= 0 );
 718             ASSERT( c->c.ldv.drag_total >= 0 );
 719         }
 720     }
 721
 722     freeHashTable(acc, NULL);
 723     arenaFree(arena);
 724 }
 725 #endif
 726
 727 /* -----------------------------------------------------------------------------
 728  * Print out the results of a heap census.
 729  * -------------------------------------------------------------------------- */
 730 static void
 731 dumpCensus( Census *census )
 732 {
 733     counter *ctr;
 734     int count;
 735
 736     printSample(rtsTrue, census->time);
 737
 738 #ifdef PROFILING
 739     if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
 740       fprintf(hp_file, "VOID\t%lu\n", (unsigned long)(census->void_total) * sizeof(W_));
 741         fprintf(hp_file, "LAG\t%lu\n",
 742                 (unsigned long)(census->not_used - census->void_total) * sizeof(W_));
 743         fprintf(hp_file, "USE\t%lu\n",
 744                 (unsigned long)(census->used - census->drag_total) * sizeof(W_));
 745         fprintf(hp_file, "INHERENT_USE\t%lu\n",
 746                 (unsigned long)(census->prim) * sizeof(W_));
 747         fprintf(hp_file, "DRAG\t%lu\n",
 748                 (unsigned long)(census->drag_total) * sizeof(W_));
 749         printSample(rtsFalse, census->time);
 750         return;
 751     }
 752 #endif
 753
 754     for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
 755
 756 #ifdef PROFILING
 757         if (RtsFlags.ProfFlags.bioSelector != NULL) {
 758             count = 0;
 759             if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector))
 760                 count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
 761             if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector))
 762                 count += ctr->c.ldv.drag_total;
 763             if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector))
 764                 count += ctr->c.ldv.void_total;
 765             if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector))
 766                 count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
 767         } else
 768 #endif
 769         {
 770             count = ctr->c.resid;
 771         }
 772
 773         ASSERT( count >= 0 );
 774
 775         if (count == 0) continue;
 776
 777 #if !defined(PROFILING)
 778         switch (RtsFlags.ProfFlags.doHeapProfile) {
 779         case HEAP_BY_CLOSURE_TYPE:
 780             fprintf(hp_file, "%s", (char *)ctr->identity);
 781             break;
 782         }
 783 #endif
 784
 785 #ifdef PROFILING
 786         switch (RtsFlags.ProfFlags.doHeapProfile) {
 787         case HEAP_BY_CCS:
 788             fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, RtsFlags.ProfFlags.ccsLength);
 789             break;
 790         case HEAP_BY_MOD:
 791         case HEAP_BY_DESCR:
 792         case HEAP_BY_TYPE:
 793             fprintf(hp_file, "%s", (char *)ctr->identity);
 794             break;
 795         case HEAP_BY_RETAINER:
 796         {
 797             RetainerSet *rs = (RetainerSet *)ctr->identity;
 798
 799             // it might be the distinguished retainer set rs_MANY:
 800             if (rs == &rs_MANY) {
 801                 fprintf(hp_file, "MANY");
 802                 break;
 803             }
 804
 805             // Mark this retainer set by negating its id, because it
 806             // has appeared in at least one census.  We print the
 807             // values of all such retainer sets into the log file at
 808             // the end.  A retainer set may exist but not feature in
 809             // any censuses if it arose as the intermediate retainer
 810             // set for some closure during retainer set calculation.
 811             if (rs->id > 0)
 812                 rs->id = -(rs->id);
 813
 814             // report in the unit of bytes: * sizeof(StgWord)
 815             printRetainerSetShort(hp_file, rs);
 816             break;
 817         }
 818         default:
 819             barf("dumpCensus; doHeapProfile");
 820         }
 821 #endif
 822
 823         fprintf(hp_file, "\t%lu\n", (unsigned long)count * sizeof(W_));
 824     }
 825
 826     printSample(rtsFalse, census->time);
 827 }
 828
 829 /* -----------------------------------------------------------------------------
 830  * Code to perform a heap census.
 831  * -------------------------------------------------------------------------- */
 832 static void
 833 heapCensusChain( Census *census, bdescr *bd )
 834 {
 835     StgPtr p;
 836     StgInfoTable *info;
 837     void *identity;
 838     nat size;
 839     counter *ctr;
 840     nat real_size;
 841     rtsBool prim;
 842
 843     for (; bd != NULL; bd = bd->link) {
 844
 845         // HACK: ignore pinned blocks, because they contain gaps.
 846         // It's not clear exactly what we'd like to do here, since we
 847         // can't tell which objects in the block are actually alive.
 848         // Perhaps the whole block should be counted as SYSTEM memory.
 849         if (bd->flags & BF_PINNED) {
 850             continue;
 851         }
 852
 853         p = bd->start;
 854         while (p < bd->free) {
 855             info = get_itbl((StgClosure *)p);
 856             prim = rtsFalse;
 857
 858             switch (info->type) {
 859
 860             case THUNK:
 861                 size = thunk_sizeW_fromITBL(info);
 862                 break;
 863
 864             case THUNK_1_1:
 865             case THUNK_0_2:
 866             case THUNK_2_0:
 867                 size = sizeofW(StgThunkHeader) + 2;
 868                 break;
 869
 870             case THUNK_1_0:
 871             case THUNK_0_1:
 872             case THUNK_SELECTOR:
 873                 size = sizeofW(StgThunkHeader) + 1;
 874                 break;
 875
 876             case CONSTR:
 877             case FUN:
 878             case IND_PERM:
 879             case IND_OLDGEN:
 880             case IND_OLDGEN_PERM:
 881             case CAF_BLACKHOLE:
 882             case BLACKHOLE:
 883             case FUN_1_0:
 884             case FUN_0_1:
 885             case FUN_1_1:
 886             case FUN_0_2:
 887             case FUN_2_0:
 888             case CONSTR_1_0:
 889             case CONSTR_0_1:
 890             case CONSTR_1_1:
 891             case CONSTR_0_2:
 892             case CONSTR_2_0:
 893                 size = sizeW_fromITBL(info);
 894                 break;
 895
 896             case IND:
 897                 // Special case/Delicate Hack: INDs don't normally
 898                 // appear, since we're doing this heap census right
 899                 // after GC.  However, GarbageCollect() also does
 900                 // resurrectThreads(), which can update some
 901                 // blackholes when it calls raiseAsync() on the
 902                 // resurrected threads.  So we know that any IND will
 903                 // be the size of a BLACKHOLE.
 904                 size = BLACKHOLE_sizeW();
 905                 break;
 906
 907             case BCO:
 908                 prim = rtsTrue;
 909                 size = bco_sizeW((StgBCO *)p);
 910                 break;
 911
 912             case MVAR_CLEAN:
 913             case MVAR_DIRTY:
 914             case WEAK:
 915             case STABLE_NAME:
 916             case MUT_VAR_CLEAN:
 917             case MUT_VAR_DIRTY:
 918                 prim = rtsTrue;
 919                 size = sizeW_fromITBL(info);
 920                 break;
 921
 922             case AP:
 923                 size = ap_sizeW((StgAP *)p);
 924                 break;
 925
 926             case PAP:
 927                 size = pap_sizeW((StgPAP *)p);
 928                 break;
 929
 930             case AP_STACK:
 931                 size = ap_stack_sizeW((StgAP_STACK *)p);
 932                 break;
 933
 934             case ARR_WORDS:
 935                 prim = rtsTrue;
 936                 size = arr_words_sizeW((StgArrWords*)p);
 937                 break;
 938
 939             case MUT_ARR_PTRS_CLEAN:
 940             case MUT_ARR_PTRS_DIRTY:
 941             case MUT_ARR_PTRS_FROZEN:
 942             case MUT_ARR_PTRS_FROZEN0:
 943                 prim = rtsTrue;
 944                 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 945                 break;
 946
 947             case TSO:
 948                 prim = rtsTrue;
 949 #ifdef PROFILING
 950                 if (RtsFlags.ProfFlags.includeTSOs) {
 951                     size = tso_sizeW((StgTSO *)p);
 952                     break;
 953                 } else {
 954                     // Skip this TSO and move on to the next object
 955                     p += tso_sizeW((StgTSO *)p);
 956                     continue;
 957                 }
 958 #else
 959                 size = tso_sizeW((StgTSO *)p);
 960                 break;
 961 #endif
 962
 963             case TREC_HEADER:
 964                 prim = rtsTrue;
 965                 size = sizeofW(StgTRecHeader);
 966                 break;
 967
 968             case TVAR_WATCH_QUEUE:
 969                 prim = rtsTrue;
 970                 size = sizeofW(StgTVarWatchQueue);
 971                 break;
 972
 973             case INVARIANT_CHECK_QUEUE:
 974                 prim = rtsTrue;
 975                 size = sizeofW(StgInvariantCheckQueue);
 976                 break;
 977
 978             case ATOMIC_INVARIANT:
 979                 prim = rtsTrue;
 980                 size = sizeofW(StgAtomicInvariant);
 981                 break;
 982
 983             case TVAR:
 984                 prim = rtsTrue;
 985                 size = sizeofW(StgTVar);
 986                 break;
 987
 988             case TREC_CHUNK:
 989                 prim = rtsTrue;
 990                 size = sizeofW(StgTRecChunk);
 991                 break;
 992
 993             default:
 994                 barf("heapCensus, unknown object: %d", info->type);
 995             }
 996
 997             identity = NULL;
 998
 999 #ifdef PROFILING
1000             // subtract the profiling overhead
1001             real_size = size - sizeofW(StgProfHeader);
1002 #else
1003             real_size = size;
1004 #endif
1005
1006             if (closureSatisfiesConstraints((StgClosure*)p)) {
1007 #ifdef PROFILING
1008                 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
1009                     if (prim)
1010                         census->prim += real_size;
1011                     else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1012                         census->not_used += real_size;
1013                     else
1014                         census->used += real_size;
1015                 } else
1016 #endif
1017                 {
1018                     identity = closureIdentity((StgClosure *)p);
1019
1020                     if (identity != NULL) {
1021                         ctr = lookupHashTable( census->hash, (StgWord)identity );
1022                         if (ctr != NULL) {
1023 #ifdef PROFILING
1024                             if (RtsFlags.ProfFlags.bioSelector != NULL) {
1025                                 if (prim)
1026                                     ctr->c.ldv.prim += real_size;
1027                                 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1028                                     ctr->c.ldv.not_used += real_size;
1029                                 else
1030                                     ctr->c.ldv.used += real_size;
1031                             } else
1032 #endif
1033                             {
1034                                 ctr->c.resid += real_size;
1035                             }
1036                         } else {
1037                             ctr = arenaAlloc( census->arena, sizeof(counter) );
1038                             initLDVCtr(ctr);
1039                             insertHashTable( census->hash, (StgWord)identity, ctr );
1040                             ctr->identity = identity;
1041                             ctr->next = census->ctrs;
1042                             census->ctrs = ctr;
1043
1044 #ifdef PROFILING
1045                             if (RtsFlags.ProfFlags.bioSelector != NULL) {
1046                                 if (prim)
1047                                     ctr->c.ldv.prim = real_size;
1048                                 else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
1049                                     ctr->c.ldv.not_used = real_size;
1050                                 else
1051                                     ctr->c.ldv.used = real_size;
1052                             } else
1053 #endif
1054                             {
1055                                 ctr->c.resid = real_size;
1056                             }
1057                         }
1058                     }
1059                 }
1060             }
1061
1062             p += size;
1063         }
1064     }
1065 }
1066
1067 void
1068 heapCensus( void )
1069 {
1070   nat g, s;
1071   Census *census;
1072
1073   census = &censuses[era];
1074   census->time  = mut_user_time();
1075
1076   // calculate retainer sets if necessary
1077 #ifdef PROFILING
1078   if (doingRetainerProfiling()) {
1079       retainerProfile();
1080   }
1081 #endif
1082
1083 #ifdef PROFILING
1084   stat_startHeapCensus();
1085 #endif
1086
1087   // Traverse the heap, collecting the census info
1088   if (RtsFlags.GcFlags.generations == 1) {
1089       heapCensusChain( census, g0s0->blocks );
1090   } else {
1091       for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1092           for (s = 0; s < generations[g].n_steps; s++) {
1093               heapCensusChain( census, generations[g].steps[s].blocks );
1094               // Are we interested in large objects?  might be
1095               // confusing to include the stack in a heap profile.
1096               heapCensusChain( census, generations[g].steps[s].large_objects );
1097           }
1098       }
1099   }
1100
1101   // dump out the census info
1102 #ifdef PROFILING
1103     // We can't generate any info for LDV profiling until
1104     // the end of the run...
1105     if (!doingLDVProfiling())
1106         dumpCensus( census );
1107 #else
1108     dumpCensus( census );
1109 #endif
1110
1111
1112   // free our storage, unless we're keeping all the census info for
1113   // future restriction by biography.
1114 #ifdef PROFILING
1115   if (RtsFlags.ProfFlags.bioSelector == NULL)
1116   {
1117       freeHashTable( census->hash, NULL/* don't free the elements */ );
1118       arenaFree( census->arena );
1119       census->hash = NULL;
1120       census->arena = NULL;
1121   }
1122 #endif
1123
1124   // we're into the next time period now
1125   nextEra();
1126
1127 #ifdef PROFILING
1128   stat_endHeapCensus();
1129 #endif
1130 }
1131