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