/* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.7 2000/03/23 13:13:29 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.39 2002/11/01 11:05:46 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#if defined(PROFILING) || defined(DEBUG_HEAP_PROF)
+#include "PosixSource.h"
#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
-#include "ProfRts.h"
+#include "Profiling.h"
#include "Storage.h"
#include "ProfHeap.h"
#include "Stats.h"
-#include "ProfRts.h"
-#ifdef DEBUG_HEAP_PROF
+#include "Hash.h"
+#include "StrHash.h"
+#include "RetainerProfile.h"
+#include "LdvProfile.h"
+#include "Arena.h"
#include "Printer.h"
-static void initSymbolHash(void);
-static void clear_table_data(void);
-static void fprint_data(FILE *fp);
-#endif
-
-char prof_filename[128]; /* urk */
-
-#ifdef DEBUG_HEAP_PROF
-FILE *prof_file;
-
-void initProfiling1( void )
-{
-}
-
-void initProfiling2( void )
-{
- initHeapProfiling();
-}
-
-void endProfiling( void )
-{
- endHeapProfiling();
-}
-#endif /* DEBUG_HEAP_PROF */
-
-nat
-initHeapProfiling(void)
-{
- if (! RtsFlags.ProfFlags.doHeapProfile) {
- return 0;
- }
-
- fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
- fprintf(prof_file, "DATE \"%s\"\n", time_str());
-
- fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
- fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
-
- fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
- fprintf(prof_file, "END_SAMPLE 0.00\n");
-
-#ifdef DEBUG_HEAP_PROF
- DEBUG_LoadSymbols(prog_argv[0]);
- initSymbolHash();
-#endif
-
- return 0;
-}
-
-void
-endHeapProfiling(void)
-{
- StgDouble seconds;
-
- if (! RtsFlags.ProfFlags.doHeapProfile) {
- return;
- }
- seconds = mut_user_time();
- fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
- fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
- fclose(prof_file);
-}
+#include <string.h>
-#ifdef DEBUG_HEAP_PROF
/* -----------------------------------------------------------------------------
- Hash table for symbols.
- -------------------------------------------------------------------------- */
-
-typedef struct {
- const char *name;
- void *ptr;
- nat data;
-} symbol_info;
-
-#define SYMBOL_HASH_SIZE 0x3fff
-
-symbol_info symbol_hash[SYMBOL_HASH_SIZE];
-
-static inline nat
-hash(void *ptr)
-{
- return ((W_)ptr)>>4 & 0x3fff;
-}
-
-static void
-initSymbolHash(void)
-{
- nat i;
+ * era stores the current time period. It is the same as the
+ * number of censuses that have been performed.
+ *
+ * RESTRICTION:
+ * era must be no longer than LDV_SHIFT (15 or 30) bits.
+ * Invariants:
+ * era is initialized to 1 in initHeapProfiling().
+ *
+ * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling().
+ * When era reaches max_era, the profiling stops because a closure can
+ * store only up to (max_era - 1) as its creation or last use time.
+ * -------------------------------------------------------------------------- */
+nat era;
+static nat max_era;
- for (i=0; i < SYMBOL_HASH_SIZE; i++) {
- symbol_hash[i].ptr = NULL;
- }
-}
+/* -----------------------------------------------------------------------------
+ * Counters
+ *
+ * For most heap profiles each closure identity gets a simple count
+ * of live words in the heap at each census. However, if we're
+ * selecting by biography, then we have to keep the various
+ * lag/drag/void counters for each identity.
+ * -------------------------------------------------------------------------- */
+typedef struct _counter {
+ void *identity;
+ 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'
+ } ldv;
+ } c;
+ struct _counter *next;
+} counter;
-static nat
-lookup_symbol(void *addr)
+static inline void
+initLDVCtr( counter *ctr )
{
- nat orig_bucket = hash(addr);
- nat bucket;
-
- bucket = orig_bucket;
- while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
- if (symbol_hash[bucket].ptr == addr) {
- return bucket;
- }
- bucket++;
- }
- if (bucket == SYMBOL_HASH_SIZE) {
- bucket = 0;
- while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
- if (symbol_hash[bucket].ptr == addr) {
- return bucket;
- }
- bucket++;
- }
- if (bucket == orig_bucket) {
- barf("out of symbol table space");
- }
- }
-
- symbol_hash[bucket].ptr = addr;
- lookupGHCName(addr,&symbol_hash[bucket].name);
- symbol_hash[bucket].data = 0;
- return bucket;
+ ctr->c.ldv.prim = 0;
+ ctr->c.ldv.not_used = 0;
+ ctr->c.ldv.used = 0;
+ ctr->c.ldv.void_total = 0;
+ ctr->c.ldv.drag_total = 0;
}
-static void
-clear_table_data(void)
-{
- nat i;
-
- for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
- symbol_hash[i].data = 0;
- }
-}
+typedef struct {
+ double time; // the time in MUT time when the census is made
+ HashTable * hash;
+ counter * ctrs;
+ Arena * arena;
+
+ // for LDV profiling, when just displaying by LDV
+ int prim;
+ int not_used;
+ int used;
+ int void_total;
+ int drag_total;
+} Census;
+
+static Census *censuses = NULL;
+static nat n_censuses = 0;
-static void
-fprint_data(FILE *fp)
-{
- nat i;
-
- for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
- if (symbol_hash[i].data) {
- fprintf(fp, " %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
- }
- }
-}
+#ifdef PROFILING
+static void aggregateCensusInfo( void );
+#endif
-static inline void
-add_data(void *addr, nat data)
-{
- symbol_hash[lookup_symbol(addr)].data += data;
-}
+static void dumpCensus( Census *census );
/* -----------------------------------------------------------------------------
Closure Type Profiling;
PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
-------------------------------------------------------------------------- */
-static nat closure_types[N_CLOSURE_TYPES];
-
+#ifdef DEBUG_HEAP_PROF
static char *type_names[] = {
"INVALID_OBJECT"
, "CONSTR"
, "EVACUATED"
};
-static void
-fprint_closure_types(FILE *fp)
+#endif /* DEBUG_HEAP_PROF */
+
+/* -----------------------------------------------------------------------------
+ * Find the "closure identity", which is a unique pointer reresenting
+ * the band to which this closure's heap space is attributed in the
+ * heap profile.
+ * ------------------------------------------------------------------------- */
+static inline void *
+closureIdentity( StgClosure *p )
{
- nat i;
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
- for (i = 0; i < N_CLOSURE_TYPES; i++) {
- if (closure_types[i]) {
- fprintf(fp, " %s %d\n", type_names[i], closure_types[i]);
+#ifdef PROFILING
+ case HEAP_BY_CCS:
+ return p->header.prof.ccs;
+ case HEAP_BY_MOD:
+ return p->header.prof.ccs->cc->module;
+ case HEAP_BY_DESCR:
+ return get_itbl(p)->prof.closure_desc;
+ case HEAP_BY_TYPE:
+ return get_itbl(p)->prof.closure_type;
+ case HEAP_BY_RETAINER:
+ // AFAIK, the only closures in the heap which might not have a
+ // valid retainer set are DEAD_WEAK closures.
+ if (isRetainerSetFieldValid(p))
+ return retainerSetOf(p);
+ else
+ return NULL;
+
+#else // DEBUG
+ case HEAP_BY_INFOPTR:
+ return (void *)((StgClosure *)p)->header.info;
+ case HEAP_BY_CLOSURE_TYPE:
+ return type_names[get_itbl(p)->type];
+
+#endif
+ default:
+ barf("closureIdentity");
}
- }
}
-#endif /* DEBUG_HEAP_PROF */
+/* --------------------------------------------------------------------------
+ * Profiling type predicates
+ * ----------------------------------------------------------------------- */
+#ifdef PROFILING
+static inline rtsBool
+doingLDVProfiling( void )
+{
+ return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
+ || RtsFlags.ProfFlags.bioSelector != NULL);
+}
+static inline rtsBool
+doingRetainerProfiling( void )
+{
+ return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
+ || RtsFlags.ProfFlags.retainerSelector != NULL);
+}
+#endif // PROFILING
+
+// Precesses a closure 'c' being destroyed whose size is 'size'.
+// Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
+// such as TSO; they should not be involved in computing dragNew or voidNew.
+//
+// Even though era is checked in both LdvCensusForDead() and
+// LdvCensusKillAll(), we still need to make sure that era is > 0 because
+// LDV_recordDead() may be called from elsewhere in the runtime system. E.g.,
+// when a thunk is replaced by an indirection object.
#ifdef PROFILING
+void
+LDV_recordDead( StgClosure *c, nat size )
+{
+ void *id;
+ nat t;
+ counter *ctr;
+
+ if (era > 0 && closureSatisfiesConstraints(c)) {
+ size -= sizeofW(StgProfHeader);
+ if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
+ 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;
+ } else {
+ id = closureIdentity(c);
+ ctr = lookupHashTable(censuses[t].hash, (StgWord)id);
+ ASSERT( ctr != NULL );
+ ctr->c.ldv.void_total += (int)size;
+ ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
+ if (ctr == NULL) {
+ ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
+ initLDVCtr(ctr);
+ insertHashTable(censuses[era].hash, (StgWord)id, ctr);
+ ctr->identity = id;
+ ctr->next = censuses[era].ctrs;
+ censuses[era].ctrs = ctr;
+ }
+ ctr->c.ldv.void_total -= (int)size;
+ }
+ }
+ } else {
+ t = LDVW((c)) & LDV_LAST_MASK;
+ if (t + 1 < era) {
+ if (RtsFlags.ProfFlags.bioSelector == NULL) {
+ censuses[t+1].drag_total += size;
+ censuses[era].drag_total -= size;
+ } else {
+ void *id;
+ id = closureIdentity(c);
+ ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
+ ASSERT( ctr != NULL );
+ ctr->c.ldv.drag_total += (int)size;
+ ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
+ if (ctr == NULL) {
+ ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
+ initLDVCtr(ctr);
+ insertHashTable(censuses[era].hash, (StgWord)id, ctr);
+ ctr->identity = id;
+ ctr->next = censuses[era].ctrs;
+ censuses[era].ctrs = ctr;
+ }
+ ctr->c.ldv.drag_total -= (int)size;
+ }
+ }
+ }
+ }
+}
+#endif
+
+/* --------------------------------------------------------------------------
+ * Initialize censuses[era];
+ * ----------------------------------------------------------------------- */
+static inline void
+initEra(Census *census)
+{
+ census->hash = allocHashTable();
+ census->ctrs = NULL;
+ census->arena = newArena();
+
+ census->not_used = 0;
+ census->used = 0;
+ census->prim = 0;
+ census->void_total = 0;
+ census->drag_total = 0;
+}
+
+/* --------------------------------------------------------------------------
+ * Increases era by 1 and initialize census[era].
+ * Reallocates gi[] and increases its size if needed.
+ * ----------------------------------------------------------------------- */
static void
-clearCCSResid(CostCentreStack *ccs)
+nextEra( void )
{
- IndexTable *i;
+#ifdef PROFILING
+ if (doingLDVProfiling()) {
+ era++;
+
+ if (era == max_era) {
+ barf("maximum number of censuses reached; use +RTS -i to reduce");
+ }
+
+ if (era == n_censuses) {
+ n_censuses *= 2;
+ censuses = stgReallocBytes(censuses, sizeof(Census) * n_censuses,
+ "nextEra");
+ }
+ }
+#endif // PROFILING
+
+ initEra( &censuses[era] );
+}
+
+/* -----------------------------------------------------------------------------
+ * DEBUG heap profiling, by info table
+ * -------------------------------------------------------------------------- */
+
+#ifdef DEBUG_HEAP_PROF
+FILE *hp_file;
- ccs->mem_resid = 0;
+void initProfiling1( void )
+{
+}
- for (i = ccs->indexTable; i != 0; i = i->next) {
- if (!i->back_edge) {
- clearCCSResid(i->ccs);
+void initProfiling2( void )
+{
+ initHeapProfiling();
+}
+
+void endProfiling( void )
+{
+ endHeapProfiling();
+}
+#endif /* DEBUG_HEAP_PROF */
+
+/* --------------------------------------------------------------------------
+ * Initialize the heap profilier
+ * ----------------------------------------------------------------------- */
+nat
+initHeapProfiling(void)
+{
+ if (! RtsFlags.ProfFlags.doHeapProfile) {
+ return 0;
}
- }
+
+#ifdef PROFILING
+ if (doingLDVProfiling() && doingRetainerProfiling()) {
+ prog_belch("cannot mix -hb and -hr");
+ stg_exit(1);
+ }
+#endif
+
+ // we only count eras if we're doing LDV profiling. Otherwise era
+ // is fixed at zero.
+#ifdef PROFILING
+ if (doingLDVProfiling()) {
+ era = 1;
+ } else
+#endif
+ {
+ era = 0;
+ }
+
+ { // max_era = 2^LDV_SHIFT
+ nat p;
+ max_era = 1;
+ for (p = 0; p < LDV_SHIFT; p++)
+ max_era *= 2;
+ }
+
+ n_censuses = 32;
+ censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");
+
+ initEra( &censuses[era] );
+
+ fprintf(hp_file, "JOB \"%s", prog_argv[0]);
+
+#ifdef PROFILING
+ {
+ int count;
+ for(count = 1; count < prog_argc; count++)
+ fprintf(hp_file, " %s", prog_argv[count]);
+ fprintf(hp_file, " +RTS ");
+ for(count = 0; count < rts_argc; count++)
+ fprintf(hp_file, "%s ", rts_argv[count]);
+ fprintf(hp_file, "\n");
+ }
+#endif /* PROFILING */
+
+ fprintf(hp_file, "\"\n" );
+
+ fprintf(hp_file, "DATE \"%s\"\n", time_str());
+
+ fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
+ fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
+
+ fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
+ fprintf(hp_file, "END_SAMPLE 0.00\n");
+
+#ifdef DEBUG_HEAP_PROF
+ DEBUG_LoadSymbols(prog_argv[0]);
+#endif
+
+#ifdef PROFILING
+ if (doingRetainerProfiling()) {
+ initRetainerProfiling();
+ }
+#endif
+
+ return 0;
}
+void
+endHeapProfiling(void)
+{
+ StgDouble seconds;
+
+ if (! RtsFlags.ProfFlags.doHeapProfile) {
+ return;
+ }
+
+#ifdef PROFILING
+ if (doingRetainerProfiling()) {
+ endRetainerProfiling();
+ }
+#endif
+
+#ifdef PROFILING
+ if (doingLDVProfiling()) {
+ nat t;
+ LdvCensusKillAll();
+ aggregateCensusInfo();
+ for (t = 1; t < era; t++) {
+ dumpCensus( &censuses[t] );
+ }
+ }
+#endif
+
+ seconds = mut_user_time();
+ fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
+ fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
+ fclose(hp_file);
+}
+
+
+
+#ifdef PROFILING
static void
-fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
+fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
{
- CostCentre *cc;
- CostCentreStack *prev;
+ char buf[max_length+1];
+ nat next_offset = 0;
+ nat written;
+ char *template;
+
+ // MAIN on its own gets printed as "MAIN", otherwise we ignore MAIN.
+ if (ccs == CCS_MAIN) {
+ fprintf(fp, "MAIN");
+ return;
+ }
- cc = ccs->cc;
- prev = ccs->prevStack;
+ fprintf(fp, "(%d)", ccs->ccsID);
- if (prev == NULL
- || prev->cc->is_subsumed != CC_IS_BORING
- || components == 1) {
- fprintf(fp,"%s",cc->label);
- return;
+ // keep printing components of the stack until we run out of space
+ // in the buffer. If we run out of space, end with "...".
+ for (; ccs != NULL && ccs != CCS_MAIN; ccs = ccs->prevStack) {
- } else {
- fprint_ccs(fp, ccs->prevStack,components-1);
- fprintf(fp,"/%s",cc->label);
- }
+ // CAF cost centres print as M.CAF, but we leave the module
+ // name out of all the others to save space.
+ if (!strcmp(ccs->cc->label,"CAF")) {
+#ifdef HAVE_SNPRINTF
+ written = snprintf(buf+next_offset,
+ (int)max_length-3-(int)next_offset,
+ "%s.CAF", ccs->cc->module);
+#else
+ written = sprintf(buf+next_offset,
+ "%s.CAF", ccs->cc->module);
+#endif
+ } else {
+ if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
+ template = "%s/";
+ } else {
+ template = "%s";
+ }
+#ifdef HAVE_SNPRINTF
+ written = snprintf(buf+next_offset,
+ (int)max_length-3-(int)next_offset,
+ template, ccs->cc->label);
+#else
+ written = sprintf(buf+next_offset,
+ template, ccs->cc->label);
+#endif
+ }
+
+ if (next_offset+written >= max_length-4) {
+ sprintf(buf+max_length-4, "...");
+ break;
+ } else {
+ next_offset += written;
+ }
+ }
+ fprintf(fp, "%s", buf);
}
+#endif // PROFILING
+rtsBool
+strMatchesSelector( char* str, char* sel )
+{
+ char* p;
+ // fprintf(stderr, "str_matches_selector %s %s\n", str, sel);
+ while (1) {
+ // Compare str against wherever we've got to in sel.
+ p = str;
+ while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
+ p++; sel++;
+ }
+ // Match if all of str used and have reached the end of a sel fragment.
+ if (*p == '\0' && (*sel == ',' || *sel == '\0'))
+ return rtsTrue;
+
+ // No match. Advance sel to the start of the next elem.
+ while (*sel != ',' && *sel != '\0') sel++;
+ if (*sel == ',') sel++;
+
+ /* Run out of sel ?? */
+ if (*sel == '\0') return rtsFalse;
+ }
+}
+
+/* -----------------------------------------------------------------------------
+ * Figure out whether a closure should be counted in this census, by
+ * testing against all the specified constraints.
+ * -------------------------------------------------------------------------- */
+rtsBool
+closureSatisfiesConstraints( StgClosure* p )
+{
+#ifdef DEBUG_HEAP_PROF
+ return rtsTrue;
+#else
+ rtsBool b;
+
+ // The CCS has a selected field to indicate whether this closure is
+ // deselected by not being mentioned in the module, CC, or CCS
+ // selectors.
+ if (!p->header.prof.ccs->selected) {
+ return rtsFalse;
+ }
+
+ if (RtsFlags.ProfFlags.descrSelector) {
+ b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
+ RtsFlags.ProfFlags.descrSelector );
+ if (!b) return rtsFalse;
+ }
+ if (RtsFlags.ProfFlags.typeSelector) {
+ b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
+ RtsFlags.ProfFlags.typeSelector );
+ if (!b) return rtsFalse;
+ }
+ if (RtsFlags.ProfFlags.retainerSelector) {
+ RetainerSet *rs;
+ nat i;
+ rs = retainerSetOf((StgClosure *)p);
+ if (rs != NULL) {
+ for (i = 0; i < rs->num; i++) {
+ b = strMatchesSelector( rs->element[i]->cc->label,
+ RtsFlags.ProfFlags.retainerSelector );
+ if (b) return rtsTrue;
+ }
+ }
+ return rtsFalse;
+ }
+ return rtsTrue;
+#endif /* PROFILING */
+}
+
+/* -----------------------------------------------------------------------------
+ * Aggregate the heap census info for biographical profiling
+ * -------------------------------------------------------------------------- */
+#ifdef PROFILING
static void
-reportCCSResid(FILE *fp, CostCentreStack *ccs)
+aggregateCensusInfo( void )
{
- IndexTable *i;
+ HashTable *acc;
+ nat t;
+ counter *c, *d, *ctrs;
+ Arena *arena;
+
+ if (!doingLDVProfiling()) return;
+
+ // Aggregate the LDV counters when displaying by biography.
+ if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
+ int void_total, drag_total;
+
+ // Now we compute void_total and drag_total for each census
+ void_total = 0;
+ drag_total = 0;
+ for (t = 1; t < era; t++) { // note: start at 1, not 0
+ void_total += censuses[t].void_total;
+ drag_total += censuses[t].drag_total;
+ censuses[t].void_total = void_total;
+ censuses[t].drag_total = drag_total;
+ ASSERT( censuses[t].void_total <= censuses[t].not_used );
+ ASSERT( censuses[t].drag_total <= censuses[t].used );
+ }
+
+ return;
+ }
- if (ccs->mem_resid != 0) {
- fprintf(fp," ");
- fprint_ccs(fp,ccs,2/*print 2 components only*/);
- fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
- }
+ // otherwise... we're doing a heap profile that is restricted to
+ // some combination of lag, drag, void or use. We've kept all the
+ // census info for all censuses so far, but we still need to
+ // aggregate the counters forwards.
+
+ arena = newArena();
+ acc = allocHashTable();
+ ctrs = NULL;
+
+ for (t = 1; t < era; t++) {
+
+ // first look through all the counters we're aggregating
+ for (c = ctrs; c != NULL; c = c->next) {
+ // if one of the totals is non-zero, then this closure
+ // type must be present in the heap at this census time...
+ d = lookupHashTable(censuses[t].hash, (StgWord)c->identity);
+
+ if (d == NULL) {
+ // if this closure identity isn't present in the
+ // census for this time period, then our running
+ // totals *must* be zero.
+ ASSERT(c->c.ldv.void_total == 0 && c->c.ldv.drag_total == 0);
+
+ // fprintCCS(stderr,c->identity);
+ // fprintf(stderr," census=%d void_total=%d drag_total=%d\n",
+ // t, c->c.ldv.void_total, c->c.ldv.drag_total);
+ } else {
+ d->c.ldv.void_total += c->c.ldv.void_total;
+ d->c.ldv.drag_total += c->c.ldv.drag_total;
+ c->c.ldv.void_total = d->c.ldv.void_total;
+ c->c.ldv.drag_total = d->c.ldv.drag_total;
+
+ ASSERT( c->c.ldv.void_total >= 0 );
+ ASSERT( c->c.ldv.drag_total >= 0 );
+ }
+ }
- for (i = ccs->indexTable; i != 0; i = i->next) {
- if (!i->back_edge) {
- reportCCSResid(fp,i->ccs);
+ // now look through the counters in this census to find new ones
+ for (c = censuses[t].ctrs; c != NULL; c = c->next) {
+ d = lookupHashTable(acc, (StgWord)c->identity);
+ if (d == NULL) {
+ d = arenaAlloc( arena, sizeof(counter) );
+ initLDVCtr(d);
+ insertHashTable( acc, (StgWord)c->identity, d );
+ d->identity = c->identity;
+ d->next = ctrs;
+ ctrs = d;
+ d->c.ldv.void_total = c->c.ldv.void_total;
+ d->c.ldv.drag_total = c->c.ldv.drag_total;
+ }
+ ASSERT( c->c.ldv.void_total >= 0 );
+ ASSERT( c->c.ldv.drag_total >= 0 );
+ }
}
- }
+
+ freeHashTable(acc, NULL);
+ arenaFree(arena);
}
#endif
-void
-heapCensus(void)
+/* -----------------------------------------------------------------------------
+ * Print out the results of a heap census.
+ * -------------------------------------------------------------------------- */
+static void
+dumpCensus( Census *census )
{
- bdescr *bd;
- const StgInfoTable *info;
- StgDouble time;
- nat size;
- StgPtr p;
-
-#ifdef DEBUG_HEAP_PROF
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_INFOPTR:
- clear_table_data();
- break;
- case HEAP_BY_CLOSURE_TYPE:
- memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
- break;
- default:
- return;
- }
+ counter *ctr;
+ int count;
+
+ fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", census->time);
+
+#ifdef PROFILING
+ if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
+ fprintf(hp_file, "VOID\t%u\n", census->void_total * sizeof(W_));
+ fprintf(hp_file, "LAG\t%u\n",
+ (census->not_used - census->void_total) * sizeof(W_));
+ fprintf(hp_file, "USE\t%u\n",
+ (census->used - census->drag_total) * sizeof(W_));
+ fprintf(hp_file, "INHERENT_USE\t%u\n",
+ census->prim * sizeof(W_));
+ fprintf(hp_file, "DRAG\t%u\n", census->drag_total *
+ sizeof(W_));
+ fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
+ return;
+ }
#endif
+ for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
+
#ifdef PROFILING
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case NO_HEAP_PROFILING:
- return;
- case HEAP_BY_CCS:
- break;
- default:
- barf("heapCensus; doHeapProfile");
- }
- /* zero all the residency counters */
- clearCCSResid(CCS_MAIN);
+ if (RtsFlags.ProfFlags.bioSelector != NULL) {
+ count = 0;
+ if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector))
+ count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
+ if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector))
+ count += ctr->c.ldv.drag_total;
+ if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector))
+ count += ctr->c.ldv.void_total;
+ if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector))
+ count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
+ } else
#endif
+ {
+ count = ctr->c.resid;
+ }
- /* Only do heap profiling in a two-space heap */
- ASSERT(RtsFlags.GcFlags.generations == 1);
- bd = g0s0->to_space;
+ ASSERT( count >= 0 );
- time = mut_user_time_during_GC();
- fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
-
- while (bd != NULL) {
- p = bd->start;
- while (p < bd->free) {
- info = get_itbl((StgClosure *)p);
-
- switch (info->type) {
- case BCO:
- size = bco_sizeW((StgBCO *)p);
- break;
-
- case CONSTR:
- if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
- size = sizeofW(StgWeak);
- break;
+ if (count == 0) continue;
+
+#ifdef DEBUG_HEAP_PROF
+ 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;
}
- /* else, fall through... */
-
- case FUN:
- case THUNK:
- case IND_PERM:
- case IND_OLDGEN_PERM:
- case CAF_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
- case SE_BLACKHOLE:
- case BLACKHOLE:
- case BLACKHOLE_BQ:
- case WEAK:
- case FOREIGN:
- case STABLE_NAME:
- case MVAR:
- case MUT_VAR:
- case CONSTR_INTLIKE:
- case CONSTR_CHARLIKE:
- case FUN_1_0:
- case FUN_0_1:
- case FUN_1_1:
- case FUN_0_2:
- case FUN_2_0:
- case THUNK_1_0:
- case THUNK_0_1:
- case THUNK_1_1:
- case THUNK_0_2:
- case THUNK_2_0:
- case CONSTR_1_0:
- case CONSTR_0_1:
- case CONSTR_1_1:
- case CONSTR_0_2:
- case CONSTR_2_0:
- size = sizeW_fromITBL(info);
- break;
-
- case THUNK_SELECTOR:
- size = sizeofW(StgHeader) + MIN_UPD_SIZE;
- break;
-
- case AP_UPD: /* we can treat this as being the same as a PAP */
- case PAP:
- size = pap_sizeW((StgPAP *)p);
- break;
-
- case ARR_WORDS:
- size = arr_words_sizeW(stgCast(StgArrWords*,p));
- break;
-
- case MUT_ARR_PTRS:
- case MUT_ARR_PTRS_FROZEN:
- size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
- break;
-
- case TSO:
- size = tso_sizeW((StgTSO *)p);
- break;
+#endif
- default:
- barf("heapCensus");
- }
+#ifdef PROFILING
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
+ case HEAP_BY_CCS:
+ fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, 25);
+ break;
+ case HEAP_BY_MOD:
+ case HEAP_BY_DESCR:
+ case HEAP_BY_TYPE:
+ fprintf(hp_file, "%s", (char *)ctr->identity);
+ break;
+ case HEAP_BY_RETAINER:
+ {
+ RetainerSet *rs = (RetainerSet *)ctr->identity;
+
+ // it might be the distinguished retainer set rs_MANY:
+ if (rs == &rs_MANY) {
+ fprintf(hp_file, "MANY");
+ break;
+ }
+
+ // Mark this retainer set by negating its id, because it
+ // has appeared in at least one census. We print the
+ // values of all such retainer sets into the log file at
+ // the end. A retainer set may exist but not feature in
+ // any censuses if it arose as the intermediate retainer
+ // set for some closure during retainer set calculation.
+ if (rs->id > 0)
+ rs->id = -(rs->id);
+
+ // report in the unit of bytes: * sizeof(StgWord)
+ printRetainerSetShort(hp_file, rs);
+ break;
+ }
+ default:
+ barf("dumpCensus; doHeapProfile");
+ }
+#endif
+
+ fprintf(hp_file, "\t%d\n", count * sizeof(W_));
+ }
+
+ fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
+}
+
+/* -----------------------------------------------------------------------------
+ * Code to perform a heap census.
+ * -------------------------------------------------------------------------- */
+static void
+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) {
+ p = bd->start;
+ while (p < bd->free) {
+ info = get_itbl((StgClosure *)p);
+ prim = rtsFalse;
+
+ switch (info->type) {
+
+ case CONSTR:
+ case FUN:
+ case THUNK:
+ case IND_PERM:
+ case IND_OLDGEN_PERM:
+ case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
+ case BLACKHOLE:
+ case BLACKHOLE_BQ:
+ case CONSTR_INTLIKE:
+ case CONSTR_CHARLIKE:
+ case FUN_1_0:
+ case FUN_0_1:
+ case FUN_1_1:
+ case FUN_0_2:
+ case FUN_2_0:
+ case THUNK_1_1:
+ case THUNK_0_2:
+ case THUNK_2_0:
+ case CONSTR_1_0:
+ case CONSTR_0_1:
+ case CONSTR_1_1:
+ case CONSTR_0_2:
+ case CONSTR_2_0:
+ size = sizeW_fromITBL(info);
+ break;
+
+ case BCO:
+ case MVAR:
+ case WEAK:
+ case FOREIGN:
+ case STABLE_NAME:
+ case MUT_VAR:
+ case MUT_CONS:
+ prim = rtsTrue;
+ size = sizeW_fromITBL(info);
+ break;
+
+ case THUNK_1_0: /* ToDo - shouldn't be here */
+ case THUNK_0_1: /* " ditto " */
+ case THUNK_SELECTOR:
+ size = sizeofW(StgHeader) + MIN_UPD_SIZE;
+ break;
+
+ case PAP:
+ case AP_UPD:
+ size = pap_sizeW((StgPAP *)p);
+ break;
+
+ case ARR_WORDS:
+ prim = rtsTrue;
+ size = arr_words_sizeW(stgCast(StgArrWords*,p));
+ break;
+
+ case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_FROZEN:
+ prim = rtsTrue;
+ size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
+ break;
+
+ case TSO:
+ prim = rtsTrue;
+ size = tso_sizeW((StgTSO *)p);
+ break;
+
+ default:
+ barf("heapCensus");
+ }
+
+ identity = NULL;
#ifdef DEBUG_HEAP_PROF
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_INFOPTR:
- add_data((void *)(*p), size * sizeof(W_));
- break;
- case HEAP_BY_CLOSURE_TYPE:
- closure_types[info->type] += size * sizeof(W_);
- break;
- }
+ 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);
-#ifdef PROFILING
- ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
+ 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
- p += size;
+ {
+ ctr->c.resid = real_size;
+ }
+ }
+ }
+ }
+ }
+
+ p += size;
+ }
}
- bd = bd->link;
+}
+
+void
+heapCensus( void )
+{
+ nat g, s;
+ Census *census;
+
+ census = &censuses[era];
+ census->time = mut_user_time();
+
+ // calculate retainer sets if necessary
+#ifdef PROFILING
+ if (doingRetainerProfiling()) {
+ retainerProfile();
}
+#endif
-#ifdef DEBUG_HEAP_PROF
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_INFOPTR:
- fprint_data(prof_file);
- break;
- case HEAP_BY_CLOSURE_TYPE:
- fprint_closure_types(prof_file);
- break;
+#ifdef PROFILING
+ stat_startHeapCensus();
+#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->to_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 );
+ }
+ }
}
+
+ // dump out the census info
+#ifdef PROFILING
+ // We can't generate any info for LDV profiling until
+ // the end of the run...
+ if (!doingLDVProfiling())
+ dumpCensus( census );
+#else
+ dumpCensus( census );
#endif
-
+
+
+ // free our storage, unless we're keeping all the census info for
+ // future restriction by biography.
#ifdef PROFILING
- reportCCSResid(prof_file,CCS_MAIN);
+ if (RtsFlags.ProfFlags.bioSelector == NULL)
#endif
+ {
+ freeHashTable( census->hash, NULL/* don't free the elements */ );
+ arenaFree( census->arena );
+ census->hash = NULL;
+ census->arena = NULL;
+ }
+
+ // we're into the next time period now
+ nextEra();
- fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
+#ifdef PROFILING
+ stat_endHeapCensus();
+#endif
}
#endif /* PROFILING || DEBUG_HEAP_PROF */