ghc/rts/ProfHeap.c

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