Eliminate atomic_inc_by and instead medofiy atomic_inc.
[ghc.git] / rts / ProfHeap.c
index 4aecd0b..f094038 100644 (file)
@@ -1,23 +1,15 @@
-/* -----------------------------------------------------------------------------
+/* ----------------------------------------------------------------------------
  *
  * (c) The GHC Team, 1998-2003
  *
  * Support for heap profiling
  *
- * ---------------------------------------------------------------------------*/
-
-#if defined(DEBUG) && !defined(PROFILING)
-#define DEBUG_HEAP_PROF
-#else
-#undef DEBUG_HEAP_PROF
-#endif
-
-#if defined(PROFILING) || defined(DEBUG_HEAP_PROF)
+ * --------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
 #include "Rts.h"
+
 #include "RtsUtils.h"
-#include "RtsFlags.h"
 #include "Profiling.h"
 #include "ProfHeap.h"
 #include "Stats.h"
 #include "LdvProfile.h"
 #include "Arena.h"
 #include "Printer.h"
+#include "sm/GCThread.h"
 
 #include <string.h>
-#include <stdlib.h>
-#include <math.h>
 
 /* -----------------------------------------------------------------------------
  * era stores the current time period.  It is the same as the
@@ -60,11 +51,11 @@ typedef struct _counter {
     union {
        nat resid;
        struct {
-           int prim;     // total size of 'inherently used' closures
-           int not_used; // total size of 'never used' closures
-           int used;     // total size of 'used at least once' closures
-           int void_total;  // current total size of 'destroyed without being used' closures
-           int drag_total;  // current total size of 'used at least once and waiting to die'
+           long prim;     // total size of 'inherently used' closures
+           long not_used; // total size of 'never used' closures
+           long used;     // total size of 'used at least once' closures
+           long void_total;  // current total size of 'destroyed without being used' closures
+           long drag_total;  // current total size of 'used at least once and waiting to die'
        } ldv;
     } c;
     struct _counter *next;
@@ -87,11 +78,11 @@ typedef struct {
     Arena     * arena;
 
     // for LDV profiling, when just displaying by LDV
-    int       prim;
-    int       not_used;
-    int       used;
-    int       void_total;
-    int       drag_total;
+    long       prim;
+    long       not_used;
+    long       used;
+    long       void_total;
+    long       drag_total;
 } Census;
 
 static Census *censuses = NULL;
@@ -103,77 +94,14 @@ static void aggregateCensusInfo( void );
 
 static void dumpCensus( Census *census );
 
-/* -----------------------------------------------------------------------------
-   Closure Type Profiling;
-
-   PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG_HEAP_PROF
-static char *type_names[] = {
-      "INVALID_OBJECT"
-    , "CONSTR"
-    , "CONSTR_STATIC"
-    , "CONSTR_NOCAF_STATIC"
-
-    , "FUN"
-    , "FUN_STATIC"
-
-    , "THUNK"
-    , "THUNK_STATIC"
-    , "THUNK_SELECTOR"
-
-    , "BCO"
-    , "AP_STACK"
-    , "AP"
-
-    , "PAP"
-
-    , "IND"
-    , "IND_OLDGEN"
-    , "IND_PERM"
-    , "IND_OLDGEN_PERM"
-    , "IND_STATIC"
-
-    , "RET_BCO"
-    , "RET_SMALL"
-    , "RET_VEC_SMALL"
-    , "RET_BIG"
-    , "RET_VEC_BIG"
-    , "RET_DYN"
-    , "UPDATE_FRAME"
-    , "CATCH_FRAME"
-    , "STOP_FRAME"
-
-    , "BLACKHOLE"
-    , "MVAR"
-
-    , "ARR_WORDS"
-
-    , "MUT_ARR_PTRS_CLEAN"
-    , "MUT_ARR_PTRS_DIRTY"
-    , "MUT_ARR_PTRS_FROZEN"
-    , "MUT_VAR_CLEAN"
-    , "MUT_VAR_DIRTY"
-
-    , "WEAK"
-  
-    , "TSO"
-
-    , "BLOCKED_FETCH"
-    , "FETCH_ME"
-
-    , "EVACUATED"
-};
-
-#endif /* DEBUG_HEAP_PROF */
+static rtsBool closureSatisfiesConstraints( StgClosure* p );
 
-/* -----------------------------------------------------------------------------
- * Find the "closure identity", which is a unique pointer reresenting
+/* ----------------------------------------------------------------------------
+ * Find the "closure identity", which is a unique pointer representing
  * the band to which this closure's heap space is attributed in the
  * heap profile.
  * ------------------------------------------------------------------------- */
-STATIC_INLINE void *
+static void *
 closureIdentity( StgClosure *p )
 {
     switch (RtsFlags.ProfFlags.doHeapProfile) {
@@ -184,9 +112,9 @@ closureIdentity( StgClosure *p )
     case HEAP_BY_MOD:
        return p->header.prof.ccs->cc->module;
     case HEAP_BY_DESCR:
-       return get_itbl(p)->prof.closure_desc;
+       return GET_PROF_DESC(get_itbl(p));
     case HEAP_BY_TYPE:
-       return get_itbl(p)->prof.closure_type;
+       return GET_PROF_TYPE(get_itbl(p));
     case HEAP_BY_RETAINER:
        // AFAIK, the only closures in the heap which might not have a
        // valid retainer set are DEAD_WEAK closures.
@@ -195,11 +123,25 @@ closureIdentity( StgClosure *p )
        else
            return NULL;
 
-#else // DEBUG
-    case HEAP_BY_INFOPTR:
-       return (void *)((StgClosure *)p)->header.info; 
+#else
     case HEAP_BY_CLOSURE_TYPE:
-       return type_names[get_itbl(p)->type];
+    {
+        StgInfoTable *info;
+        info = get_itbl(p);
+        switch (info->type) {
+        case CONSTR:
+        case CONSTR_1_0:
+        case CONSTR_0_1:
+        case CONSTR_2_0:
+        case CONSTR_1_1:
+        case CONSTR_0_2:
+        case CONSTR_STATIC:
+        case CONSTR_NOCAF_STATIC:
+            return GET_CON_DESC(itbl_to_con_itbl(info));
+        default:
+            return closure_type_names[info->type];
+        }
+    }
 
 #endif
     default:
@@ -250,14 +192,14 @@ LDV_recordDead( StgClosure *c, nat size )
            t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
            if (t < era) {
                if (RtsFlags.ProfFlags.bioSelector == NULL) {
-                   censuses[t].void_total   += (int)size;
-                   censuses[era].void_total -= (int)size;
+                    censuses[t].void_total   += (long)size;
+                    censuses[era].void_total -= (long)size;
                    ASSERT(censuses[t].void_total < censuses[t].not_used);
                } else {
                    id = closureIdentity(c);
                    ctr = lookupHashTable(censuses[t].hash, (StgWord)id);
                    ASSERT( ctr != NULL );
-                   ctr->c.ldv.void_total += (int)size;
+                    ctr->c.ldv.void_total += (long)size;
                    ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
                    if (ctr == NULL) {
                        ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
@@ -267,7 +209,7 @@ LDV_recordDead( StgClosure *c, nat size )
                        ctr->next = censuses[era].ctrs;
                        censuses[era].ctrs = ctr;
                    }
-                   ctr->c.ldv.void_total -= (int)size;
+                    ctr->c.ldv.void_total -= (long)size;
                }
            }
        } else {
@@ -281,7 +223,7 @@ LDV_recordDead( StgClosure *c, nat size )
                    id = closureIdentity(c);
                    ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
                    ASSERT( ctr != NULL );
-                   ctr->c.ldv.drag_total += (int)size;
+                    ctr->c.ldv.drag_total += (long)size;
                    ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
                    if (ctr == NULL) {
                        ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
@@ -291,7 +233,7 @@ LDV_recordDead( StgClosure *c, nat size )
                        ctr->next = censuses[era].ctrs;
                        censuses[era].ctrs = ctr;
                    }
-                   ctr->c.ldv.drag_total -= (int)size;
+                    ctr->c.ldv.drag_total -= (long)size;
                }
            }
        }
@@ -302,6 +244,7 @@ LDV_recordDead( StgClosure *c, nat size )
 /* --------------------------------------------------------------------------
  * Initialize censuses[era];
  * ----------------------------------------------------------------------- */
+
 STATIC_INLINE void
 initEra(Census *census)
 {
@@ -316,10 +259,22 @@ initEra(Census *census)
     census->drag_total = 0;
 }
 
+STATIC_INLINE void
+freeEra(Census *census)
+{
+    if (RtsFlags.ProfFlags.bioSelector != NULL)
+        // when bioSelector==NULL, these are freed in heapCensus()
+    {
+        arenaFree(census->arena);
+        freeHashTable(census->hash, NULL);
+    }
+}
+
 /* --------------------------------------------------------------------------
  * Increases era by 1 and initialize census[era].
  * Reallocates gi[] and increases its size if needed.
  * ----------------------------------------------------------------------- */
+
 static void
 nextEra( void )
 {
@@ -343,24 +298,43 @@ nextEra( void )
     initEra( &censuses[era] );
 }
 
-/* -----------------------------------------------------------------------------
- * DEBUG heap profiling, by info table
- * -------------------------------------------------------------------------- */
+/* ----------------------------------------------------------------------------
+ * Heap profiling by info table
+ * ------------------------------------------------------------------------- */
 
-#ifdef DEBUG_HEAP_PROF
+#if !defined(PROFILING)
 FILE *hp_file;
 static char *hp_filename;
 
-void initProfiling1( void )
+void initProfiling1 (void)
 {
 }
 
-void initProfiling2( void )
+void freeProfiling (void)
 {
+}
+
+void initProfiling2 (void)
+{
+    char *prog;
+
+    prog = stgMallocBytes(strlen(prog_name) + 1, "initProfiling2");
+    strcpy(prog, prog_name);
+#ifdef mingw32_HOST_OS
+    // on Windows, drop the .exe suffix if there is one
+    {
+        char *suff;
+        suff = strrchr(prog,'.');
+        if (suff != NULL && !strcmp(suff,".exe")) {
+            *suff = '\0';
+        }
+    }
+#endif
+
   if (RtsFlags.ProfFlags.doHeapProfile) {
     /* Initialise the log file name */
-    hp_filename = stgMallocBytes(strlen(prog_name) + 6, "hpFileName");
-    sprintf(hp_filename, "%s.hp", prog_name);
+    hp_filename = stgMallocBytes(strlen(prog) + 6, "hpFileName");
+    sprintf(hp_filename, "%s.hp", prog);
     
     /* open the log file */
     if ((hp_file = fopen(hp_filename, "w")) == NULL) {
@@ -371,6 +345,8 @@ void initProfiling2( void )
     }
   }
   
+  stgFree(prog);
+
   initHeapProfiling();
 }
 
@@ -378,7 +354,7 @@ void endProfiling( void )
 {
   endHeapProfiling();
 }
-#endif /* DEBUG_HEAP_PROF */
+#endif /* !PROFILING */
 
 static void
 printSample(rtsBool beginSample, StgDouble sampleValue)
@@ -388,6 +364,9 @@ printSample(rtsBool beginSample, StgDouble sampleValue)
     fprintf(hp_file, "%s %" FMT_Word64 ".%02" FMT_Word64 "\n",
             (beginSample ? "BEGIN_SAMPLE" : "END_SAMPLE"),
             (StgWord64)integralPart, (StgWord64)(fractionalPart * 100));
+    if (!beginSample) {
+        fflush(hp_file);
+    }
 }
 
 /* --------------------------------------------------------------------------
@@ -418,12 +397,8 @@ initHeapProfiling(void)
        era = 0;
     }
 
-    {   // max_era = 2^LDV_SHIFT
-       nat p;
-       max_era = 1;
-       for (p = 0; p < LDV_SHIFT; p++)
-           max_era *= 2;
-    }
+    // max_era = 2^LDV_SHIFT
+       max_era = 1 << LDV_SHIFT;
 
     n_censuses = 32;
     censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");
@@ -454,10 +429,6 @@ initHeapProfiling(void)
     printSample(rtsTrue, 0);
     printSample(rtsFalse, 0);
 
-#ifdef DEBUG_HEAP_PROF
-    DEBUG_LoadSymbols(prog_name);
-#endif
-
 #ifdef PROFILING
     if (doingRetainerProfiling()) {
        initRetainerProfiling();
@@ -493,6 +464,21 @@ endHeapProfiling(void)
     }
 #endif
 
+#ifdef PROFILING
+    if (doingLDVProfiling()) {
+        nat t;
+        for (t = 1; t <= era; t++) {
+            freeEra( &censuses[t] );
+        }
+    } else {
+        freeEra( &censuses[0] );
+    }
+#else
+    freeEra( &censuses[0] );
+#endif
+
+    stgFree(censuses);
+
     seconds = mut_user_time();
     printSample(rtsTrue, seconds);
     printSample(rtsFalse, seconds);
@@ -553,7 +539,6 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
     }
     fprintf(fp, "%s", buf);
 }
-#endif /* PROFILING */
 
 rtsBool
 strMatchesSelector( char* str, char* sel )
@@ -579,14 +564,16 @@ strMatchesSelector( char* str, char* sel )
    }
 }
 
+#endif /* PROFILING */
+
 /* -----------------------------------------------------------------------------
  * Figure out whether a closure should be counted in this census, by
  * testing against all the specified constraints.
  * -------------------------------------------------------------------------- */
-rtsBool
+static rtsBool
 closureSatisfiesConstraints( StgClosure* p )
 {
-#ifdef DEBUG_HEAP_PROF
+#if !defined(PROFILING)
     (void)p;   /* keep gcc -Wall happy */
     return rtsTrue;
 #else
@@ -600,12 +587,12 @@ closureSatisfiesConstraints( StgClosure* p )
    }
 
    if (RtsFlags.ProfFlags.descrSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
+       b = strMatchesSelector( (GET_PROF_DESC(get_itbl((StgClosure *)p))),
                                 RtsFlags.ProfFlags.descrSelector );
        if (!b) return rtsFalse;
    }
    if (RtsFlags.ProfFlags.typeSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
+       b = strMatchesSelector( (GET_PROF_TYPE(get_itbl((StgClosure *)p))),
                                 RtsFlags.ProfFlags.typeSelector );
        if (!b) return rtsFalse;
    }
@@ -648,7 +635,7 @@ aggregateCensusInfo( void )
 
     // Aggregate the LDV counters when displaying by biography.
     if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
-       int void_total, drag_total;
+        long void_total, drag_total;
 
        // Now we compute void_total and drag_total for each census
        // After the program has finished, the void_total field of
@@ -748,7 +735,7 @@ static void
 dumpCensus( Census *census )
 {
     counter *ctr;
-    int count;
+    long count;
 
     printSample(rtsTrue, census->time);
 
@@ -791,11 +778,8 @@ dumpCensus( Census *census )
 
        if (count == 0) continue;
 
-#ifdef DEBUG_HEAP_PROF
+#if !defined(PROFILING)
        switch (RtsFlags.ProfFlags.doHeapProfile) {
-       case HEAP_BY_INFOPTR:
-           fprintf(hp_file, "%s", lookupGHCName(ctr->identity));
-           break;
        case HEAP_BY_CLOSURE_TYPE:
            fprintf(hp_file, "%s", (char *)ctr->identity);
            break;
@@ -832,7 +816,7 @@ dumpCensus( Census *census )
                rs->id = -(rs->id);
 
            // report in the unit of bytes: * sizeof(StgWord)
-           printRetainerSetShort(hp_file, rs);
+           printRetainerSetShort(hp_file, rs, RtsFlags.ProfFlags.ccsLength);
            break;
        }
        default:
@@ -840,12 +824,90 @@ dumpCensus( Census *census )
        }
 #endif
 
-       fprintf(hp_file, "\t%lu\n", (unsigned long)count * sizeof(W_));
+       fprintf(hp_file, "\t%" FMT_SizeT "\n", (W_)count * sizeof(W_));
     }
 
     printSample(rtsFalse, census->time);
 }
 
+
+static void heapProfObject(Census *census, StgClosure *p, nat size,
+                           rtsBool prim
+#ifndef PROFILING
+                           STG_UNUSED
+#endif
+                           )
+{
+    void *identity;
+    nat real_size;
+    counter *ctr;
+
+            identity = NULL;
+
+#ifdef PROFILING
+           // subtract the profiling overhead
+           real_size = size - sizeofW(StgProfHeader);
+#else
+           real_size = size;
+#endif
+
+           if (closureSatisfiesConstraints((StgClosure*)p)) {
+#ifdef PROFILING
+               if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
+                   if (prim)
+                       census->prim += real_size;
+                   else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
+                       census->not_used += real_size;
+                   else
+                       census->used += real_size;
+               } else
+#endif
+               {
+                   identity = closureIdentity((StgClosure *)p);
+
+                   if (identity != NULL) {
+                       ctr = lookupHashTable( census->hash, (StgWord)identity );
+                       if (ctr != NULL) {
+#ifdef PROFILING
+                           if (RtsFlags.ProfFlags.bioSelector != NULL) {
+                               if (prim)
+                                   ctr->c.ldv.prim += real_size;
+                               else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
+                                   ctr->c.ldv.not_used += real_size;
+                               else
+                                   ctr->c.ldv.used += real_size;
+                           } else
+#endif
+                           {
+                               ctr->c.resid += real_size;
+                           }
+                       } else {
+                           ctr = arenaAlloc( census->arena, sizeof(counter) );
+                           initLDVCtr(ctr);
+                           insertHashTable( census->hash, (StgWord)identity, ctr );
+                           ctr->identity = identity;
+                           ctr->next = census->ctrs;
+                           census->ctrs = ctr;
+
+#ifdef PROFILING
+                           if (RtsFlags.ProfFlags.bioSelector != NULL) {
+                               if (prim)
+                                   ctr->c.ldv.prim = real_size;
+                               else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
+                                   ctr->c.ldv.not_used = real_size;
+                               else
+                                   ctr->c.ldv.used = real_size;
+                           } else
+#endif
+                           {
+                               ctr->c.resid = real_size;
+                           }
+                       }
+                   }
+               }
+           }
+}
+
 /* -----------------------------------------------------------------------------
  * Code to perform a heap census.
  * -------------------------------------------------------------------------- */
@@ -854,26 +916,26 @@ heapCensusChain( Census *census, bdescr *bd )
 {
     StgPtr p;
     StgInfoTable *info;
-    void *identity;
     nat size;
-    counter *ctr;
-    nat real_size;
     rtsBool prim;
 
     for (; bd != NULL; bd = bd->link) {
 
-       // HACK: ignore pinned blocks, because they contain gaps.
-       // It's not clear exactly what we'd like to do here, since we
-       // can't tell which objects in the block are actually alive.
-       // Perhaps the whole block should be counted as SYSTEM memory.
-       if (bd->flags & BF_PINNED) {
-           continue;
-       }
+        // HACK: pretend a pinned block is just one big ARR_WORDS
+        // owned by CCS_PINNED.  These blocks can be full of holes due
+        // to alignment constraints so we can't traverse the memory
+        // and do a proper census.
+        if (bd->flags & BF_PINNED) {
+            StgClosure arr;
+            SET_HDR(&arr, &stg_ARR_WORDS_info, CCS_PINNED);
+            heapProfObject(census, &arr, bd->blocks * BLOCK_SIZE_W, rtsTrue);
+            continue;
+        }
 
        p = bd->start;
        while (p < bd->free) {
            info = get_itbl((StgClosure *)p);
-           prim = rtsFalse;
+            prim = rtsFalse;
            
            switch (info->type) {
 
@@ -896,12 +958,8 @@ heapCensusChain( Census *census, bdescr *bd )
            case CONSTR:
            case FUN:
            case IND_PERM:
-           case IND_OLDGEN:
-           case IND_OLDGEN_PERM:
-           case CAF_BLACKHOLE:
-           case SE_CAF_BLACKHOLE:
-           case SE_BLACKHOLE:
            case BLACKHOLE:
+           case BLOCKING_QUEUE:
            case FUN_1_0:
            case FUN_0_1:
            case FUN_1_1:
@@ -927,13 +985,16 @@ heapCensusChain( Census *census, bdescr *bd )
                break;
 
            case BCO:
-               prim = rtsTrue;
+                prim = rtsTrue;
                size = bco_sizeW((StgBCO *)p);
                break;
 
-           case MVAR:
-           case WEAK:
-           case STABLE_NAME:
+            case MVAR_CLEAN:
+            case MVAR_DIRTY:
+            case TVAR:
+            case WEAK:
+           case PRIM:
+           case MUT_PRIM:
            case MUT_VAR_CLEAN:
            case MUT_VAR_DIRTY:
                prim = rtsTrue;
@@ -954,7 +1015,7 @@ heapCensusChain( Census *census, bdescr *bd )
                
            case ARR_WORDS:
                prim = rtsTrue;
-               size = arr_words_sizeW(stgCast(StgArrWords*,p));
+               size = arr_words_sizeW((StgArrWords*)p);
                break;
                
            case MUT_ARR_PTRS_CLEAN:
@@ -967,46 +1028,37 @@ heapCensusChain( Census *census, bdescr *bd )
                
            case TSO:
                prim = rtsTrue;
-#ifdef DEBUG_HEAP_PROF
-               size = tso_sizeW((StgTSO *)p);
-               break;
-#else
+#ifdef PROFILING
                if (RtsFlags.ProfFlags.includeTSOs) {
-                   size = tso_sizeW((StgTSO *)p);
+                    size = sizeofW(StgTSO);
                    break;
                } else {
                    // Skip this TSO and move on to the next object
-                   p += tso_sizeW((StgTSO *)p);
+                    p += sizeofW(StgTSO);
                    continue;
                }
+#else
+                size = sizeofW(StgTSO);
+               break;
 #endif
 
-           case TREC_HEADER: 
+            case STACK:
                prim = rtsTrue;
-               size = sizeofW(StgTRecHeader);
+#ifdef PROFILING
+               if (RtsFlags.ProfFlags.includeTSOs) {
+                    size = stack_sizeW((StgStack*)p);
+                    break;
+               } else {
+                   // Skip this TSO and move on to the next object
+                    p += stack_sizeW((StgStack*)p);
+                   continue;
+               }
+#else
+                size = stack_sizeW((StgStack*)p);
                break;
+#endif
 
-           case TVAR_WATCH_QUEUE:
-               prim = rtsTrue;
-               size = sizeofW(StgTVarWatchQueue);
-               break;
-               
-           case INVARIANT_CHECK_QUEUE:
-               prim = rtsTrue;
-               size = sizeofW(StgInvariantCheckQueue);
-               break;
-               
-           case ATOMIC_INVARIANT:
-               prim = rtsTrue;
-               size = sizeofW(StgAtomicInvariant);
-               break;
-               
-           case TVAR:
-               prim = rtsTrue;
-               size = sizeofW(StgTVar);
-               break;
-               
-           case TREC_CHUNK:
+            case TREC_CHUNK:
                prim = rtsTrue;
                size = sizeofW(StgTRecChunk);
                break;
@@ -1015,84 +1067,21 @@ heapCensusChain( Census *census, bdescr *bd )
                barf("heapCensus, unknown object: %d", info->type);
            }
            
-           identity = NULL;
-
-#ifdef DEBUG_HEAP_PROF
-           real_size = size;
-#else
-           // subtract the profiling overhead
-           real_size = size - sizeofW(StgProfHeader);
-#endif
-
-           if (closureSatisfiesConstraints((StgClosure*)p)) {
-#ifdef PROFILING
-               if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
-                   if (prim)
-                       census->prim += real_size;
-                   else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
-                       census->not_used += real_size;
-                   else
-                       census->used += real_size;
-               } else
-#endif
-               {
-                   identity = closureIdentity((StgClosure *)p);
-
-                   if (identity != NULL) {
-                       ctr = lookupHashTable( census->hash, (StgWord)identity );
-                       if (ctr != NULL) {
-#ifdef PROFILING
-                           if (RtsFlags.ProfFlags.bioSelector != NULL) {
-                               if (prim)
-                                   ctr->c.ldv.prim += real_size;
-                               else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
-                                   ctr->c.ldv.not_used += real_size;
-                               else
-                                   ctr->c.ldv.used += real_size;
-                           } else
-#endif
-                           {
-                               ctr->c.resid += real_size;
-                           }
-                       } else {
-                           ctr = arenaAlloc( census->arena, sizeof(counter) );
-                           initLDVCtr(ctr);
-                           insertHashTable( census->hash, (StgWord)identity, ctr );
-                           ctr->identity = identity;
-                           ctr->next = census->ctrs;
-                           census->ctrs = ctr;
-
-#ifdef PROFILING
-                           if (RtsFlags.ProfFlags.bioSelector != NULL) {
-                               if (prim)
-                                   ctr->c.ldv.prim = real_size;
-                               else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
-                                   ctr->c.ldv.not_used = real_size;
-                               else
-                                   ctr->c.ldv.used = real_size;
-                           } else
-#endif
-                           {
-                               ctr->c.resid = real_size;
-                           }
-                       }
-                   }
-               }
-           }
+            heapProfObject(census,(StgClosure*)p,size,prim);
 
            p += size;
        }
     }
 }
 
-void
-heapCensus( void )
+void heapCensus (Time t)
 {
-  nat g, s;
+  nat g, n;
   Census *census;
+  gen_workspace *ws;
 
   census = &censuses[era];
-  census->time  = mut_user_time();
+  census->time  = mut_user_time_until(t);
     
   // calculate retainer sets if necessary
 #ifdef PROFILING
@@ -1106,23 +1095,17 @@ heapCensus( void )
 #endif
 
   // Traverse the heap, collecting the census info
-
-  // First the small_alloc_list: we have to fix the free pointer at
-  // the end by calling tidyAllocatedLists() first.
-  tidyAllocateLists();
-  heapCensusChain( census, small_alloc_list );
-
-  // Now traverse the heap in each generation/step.
-  if (RtsFlags.GcFlags.generations == 1) {
-      heapCensusChain( census, g0s0->blocks );
-  } else {
-      for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-         for (s = 0; s < generations[g].n_steps; s++) {
-             heapCensusChain( census, generations[g].steps[s].blocks );
-             // Are we interested in large objects?  might be
-             // confusing to include the stack in a heap profile.
-             heapCensusChain( census, generations[g].steps[s].large_objects );
-         }
+  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+      heapCensusChain( census, generations[g].blocks );
+      // Are we interested in large objects?  might be
+      // confusing to include the stack in a heap profile.
+      heapCensusChain( census, generations[g].large_objects );
+
+      for (n = 0; n < n_capabilities; n++) {
+          ws = &gc_threads[n]->gens[g];
+          heapCensusChain(census, ws->todo_bd);
+          heapCensusChain(census, ws->part_list);
+          heapCensusChain(census, ws->scavd_list);
       }
   }
 
@@ -1141,13 +1124,13 @@ heapCensus( void )
   // future restriction by biography.
 #ifdef PROFILING
   if (RtsFlags.ProfFlags.bioSelector == NULL)
-#endif
   {
       freeHashTable( census->hash, NULL/* don't free the elements */ );
       arenaFree( census->arena );
       census->hash = NULL;
       census->arena = NULL;
   }
+#endif
 
   // we're into the next time period now
   nextEra();
@@ -1157,5 +1140,3 @@ heapCensus( void )
 #endif
 }    
 
-#endif /* PROFILING || DEBUG_HEAP_PROF */
-