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