Profiling cleanup.
This commit eliminates some duplication in the various heap profiling
subsystems, and generally centralises much of the machinery. The key
concept is the separation of a heap *census* (which is now done in one
place only instead of three) from the calculation of retainer sets.
Previously the retainer profiling code also did a heap census on the
fly, and lag-drag-void profiling had its own census machinery.
Value-adds:
- you can now restrict a heap profile to certain retainer sets,
but still display by cost centre (or type, or closure or
whatever).
- I've added an option to restrict the maximum retainer set size
(+RTS -R<size>, defaulting to 8).
- I've cleaned up the heap profiling options at the request of
Simon PJ. See the help text for details. The new scheme
is backwards compatible with the old.
- I've removed some odd bits of LDV or retainer profiling-specific
code from various parts of the system.
- the time taken doing heap censuses (and retainer set calculation)
is now accurately reported by the RTS when you say +RTS -Sstderr.
Still to come:
- restricting a profile to a particular biography
(lag/drag/void/use). This requires keeping old heap censuses
around, but the infrastructure is now in place to do this.
/* ----------------------------------------------------------------------------
- * $Id: Closures.h,v 1.29 2001/11/22 14:25:11 simonmar Exp $
+ * $Id: Closures.h,v 1.30 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
typedef struct {
CostCentreStack *ccs;
union {
- RetainerSet *rs; // Retainer Set
+ struct _RetainerSet *rs; // Retainer Set
StgWord ldvw; // Lag/Drag/Void Word
} hp;
} StgProfHeader;
/* ----------------------------------------------------------------------------
- * $Id: Constants.h,v 1.18 2001/10/03 13:57:42 simonmar Exp $
+ * $Id: Constants.h,v 1.19 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
-------------------------------------------------------------------------- */
/* The size of a block (2^BLOCK_SHIFT bytes) */
-#define BLOCK_SHIFT 12
+#define BLOCK_SHIFT 11
/* The size of a megablock (2^MBLOCK_SHIFT bytes) */
#define MBLOCK_SHIFT 20
/* -----------------------------------------------------------------------------
- * $Id: RtsFlags.h,v 1.39 2001/11/25 16:57:38 sof Exp $
+ * $Id: RtsFlags.h,v 1.40 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
# define HEAP_BY_MOD 2
# define HEAP_BY_DESCR 4
# define HEAP_BY_TYPE 5
-/* Flags for retainer and lag-drag-void profiling */
# define HEAP_BY_RETAINER 6
# define HEAP_BY_LDV 7
rtsBool showCCSOnException;
-# define CCchar 'C'
-# define MODchar 'M'
-# define DESCRchar 'D'
-# define TYPEchar 'Y'
+ nat maxRetainerSetSize;
char* modSelector;
char* descrSelector;
char* typeSelector;
char* ccSelector;
-
+ char* retainerSelector;
+ char* bioSelector;
};
#elif defined(DEBUG)
/* -----------------------------------------------------------------------------
- * $Id: Stg.h,v 1.41 2001/11/25 03:56:39 sof Exp $
+ * $Id: Stg.h,v 1.42 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
/* Profiling information */
#include "StgProf.h"
-#include "StgRetainerProf.h"
#include "StgLdvProf.h"
/* Storage format definitions */
/* -----------------------------------------------------------------------------
- * $Id: StgLdvProf.h,v 1.1 2001/11/22 14:25:11 simonmar Exp $
+ * $Id: StgLdvProf.h,v 1.2 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
#ifndef STGLDVPROF_H
#define STGLDVPROF_H
-#ifdef PROFILING
-
-// Engine
-
-// declared in LdvProfile.c
-extern nat ldvTime;
-
-// LdvGenInfo stores the statistics for one specific census.
-typedef struct {
- double time; // the time in MUT time at the corresponding census is made
-
- // We employ int instead of nat, for some values may be negative temporarily,
- // e.g., dragNew.
-
- // computed at each census
- int inherentlyUsed; // total size of 'inherently used' closures
- int notUsed; // total size of 'never used' closures
- int used; // total size of 'used at least once' closures
-
- /*
- voidNew and dragNew are updated when a closure is destroyed.
- For instance, when a 'never used' closure of size s and creation time
- t is destroyed at time u, voidNew of eras t through u - 1 is increased
- by s.
- Likewise, when a 'used at least once' closure of size s and last use time
- t is destroyed at time u, dragNew of eras t + 1 through u - 1 is increase
- by s.
- In our implementation, voidNew and dragNew are computed indirectly: instead
- of updating voidNew or dragNew of all intervening eras, we update that
- of the end two eras (one is increased and the other is decreased).
- */
- int voidNew; // current total size of 'destroyed without being used' closures
- int dragNew; // current total size of 'used at least once and waiting to die'
- // closures
-
- // computed post-mortem
- int voidTotal; // total size of closures in 'void' state
- // lagTotal == notUsed - voidTotal // in 'lag' state
- int dragTotal; // total size of closures in 'drag' state
- // useTotal == used - dragTotal // in 'use' state
-} LdvGenInfo;
-
-extern LdvGenInfo *gi;
-
-// retrieves the LDV word from closure c
-#define LDVW(c) (((StgClosure *)(c))->header.prof.hp.ldvw)
-
/*
An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation
time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK).
#define LDV_STATE_USE 0x40000000
#endif // SIZEOF_VOID_P
+#ifdef PROFILING
+
+extern nat era;
+
+// retrieves the LDV word from closure c
+#define LDVW(c) (((StgClosure *)(c))->header.prof.hp.ldvw)
+
// Stores the creation time for closure c.
// This macro is called at the very moment of closure creation.
//
// because retainer profiling also expects LDVW(c) to be initialised
// to zero.
#define LDV_recordCreate(c) \
- LDVW((c)) = (ldvTime << LDV_SHIFT) | LDV_STATE_CREATE
+ LDVW((c)) = (era << LDV_SHIFT) | LDV_STATE_CREATE
// Stores the last use time for closure c.
// This macro *must* be called whenever a closure is used, that is, it is
// entered.
-#define LDV_recordUse(c) \
- { \
- if (ldvTime > 0) \
- LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) | \
- ldvTime | \
- LDV_STATE_USE; \
+#define LDV_recordUse(c) \
+ { \
+ if (era > 0) \
+ LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) | \
+ era | \
+ LDV_STATE_USE; \
}
-// Creates a 0-filled slop of size 'howManyBackwards' backwards from the
-// address 'from'.
-//
-// Invoked when:
-// 1) Hp is incremented and exceeds HpLim (in Updates.hc).
-// 2) copypart() is called (in GC.c).
-#define FILL_SLOP(from, howManyBackwards) \
- if (ldvTime > 0) { \
- int i; \
- for (i = 0;i < (howManyBackwards); i++) \
- ((StgWord *)(from))[-i] = 0; \
- }
-
-// Informs the LDV profiler that closure c has just been evacuated.
-// Evacuated objects are no longer needed, so we just store its original size in
-// the LDV field.
-#define SET_EVACUAEE_FOR_LDV(c, size) \
- LDVW((c)) = (size)
-
// Macros called when a closure is entered.
// The closure is not an 'inherently used' one.
// The closure is not IND or IND_OLDGEN because neither is considered for LDV
/* -----------------------------------------------------------------------------
- * $Id: StgProf.h,v 1.14 2001/11/22 14:25:11 simonmar Exp $
+ * $Id: StgProf.h,v 1.15 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998
*
unsigned long time_ticks;
unsigned long long mem_alloc;
- unsigned long mem_resid;
unsigned long inherited_ticks;
unsigned long long inherited_alloc;
scc_count : 0, \
time_ticks : 0, \
mem_alloc : 0, \
- mem_resid : 0, \
inherited_ticks : 0, \
inherited_alloc : 0, \
root : 0, \
+++ /dev/null
-/* -----------------------------------------------------------------------------
- * $Id: StgRetainerProf.h,v 1.1 2001/11/22 14:25:12 simonmar Exp $
- *
- * (c) The GHC Team, 2001
- *
- * Retainer profiling
- * ---------------------------------------------------------------------------*/
-
-#ifndef STGRETAINERPROF_H
-#define STGRETAINERPROF_H
-
-/*
- Type 'retainer' defines the retainer identity.
-
- Invariant:
- 1. The retainer identity of a given retainer cannot change during
- program execution, no matter where it is actually stored.
- For instance, the memory address of a retainer cannot be used as
- its retainer identity because its location may change during garbage
- collections.
- 2. Type 'retainer' must come with comparison operations as well as
- an equality operation. That it, <, >, and == must be supported -
- this is necessary to store retainers in a sorted order in retainer sets.
- Therefore, you cannot use a huge structure type as 'retainer', for instance.
-
- We illustrate three possibilities of defining 'retainer identity'.
- Choose one of the following three compiler directives:
-
- Retainer scheme 1 (RETAINER_SCHEME_INFO) : retainer = info table
- Retainer scheme 2 (RETAINER_SCHEME_CCS) : retainer = cost centre stack
- Retainer scheme 3 (RETAINER_SCHEME_CC) : retainer = cost centre
-*/
-
-// #define RETAINER_SCHEME_INFO
-#define RETAINER_SCHEME_CCS
-// #define RETAINER_SCHEME_CC
-
-#ifdef RETAINER_SCHEME_INFO
-struct _StgInfoTable;
-typedef struct _StgInfoTable *retainer;
-#endif
-
-#ifdef RETAINER_SCHEME_CCS
-typedef CostCentreStack *retainer;
-#endif
-
-#ifdef RETAINER_SCHEME_CC
-typedef CostCentre *retainer;
-#endif
-
-/*
- Type 'retainerSet' defines an abstract datatype for sets of retainers.
-
- Invariants:
- A retainer set stores its elements in increasing order (in element[] array).
- */
-
-typedef struct _RetainerSet {
- nat num; // number of elements
- nat cost; // cost associated with this retainer set
- StgWord hashKey; // hash key for this retainer set
- struct _RetainerSet *link; // link to the next retainer set in the bucket
- int id; // unique id of this retainer set (used when printing)
- // Its absolute value is interpreted as its true id; if id is
- // negative, it indicates that this retainer set has had a postive
- // cost after some retainer profiling.
- retainer element[0]; // elements of this retainer set
- // do not put anything below here!
-} RetainerSet;
-
-//
-// retainerSet - interface: see rts/RetainerSet.h
-//
-
-#endif /* STGRETAINERPROF_H */
/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.127 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: GC.c,v 1.128 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
stp->hp = to;
upd_evacuee(src,(StgClosure *)dest);
#ifdef PROFILING
- // @LDV profiling
// We store the size of the just evacuated object in the LDV word so that
// the profiler can guess the position of the next object later.
SET_EVACUAEE_FOR_LDV(src, size_org);
stp->hp += size_to_reserve;
upd_evacuee(src,(StgClosure *)dest);
#ifdef PROFILING
- // @LDV profiling
// We store the size of the just evacuated object in the LDV word so that
// the profiler can guess the position of the next object later.
// size_to_copy_org is wrong because the closure already occupies size_to_reserve
/* -----------------------------------------------------------------------------
- * $Id: LdvProfile.c,v 1.1 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: LdvProfile.c,v 1.2 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
#include "RtsUtils.h"
#include "Schedule.h"
-/*
- ldvTime stores the current LDV time, that is, the current era. It
- is one larger than the number of times LDV profiling has been
- performed, i.e.,
- ldvTime - 1 == the number of time LDV profiling was executed
- == the number of censuses made so far.
- RESTRICTION:
- ldvTime must be no longer than LDV_SHIFT (15 or 30) bits.
- Invariants:
- LDV profiling is turned off if ldvTime is 0.
- LDV profiling is turned on if ldvTime is > 0.
- ldvTime is initialized to 1 in initLdvProfiling().
- If LDV profiling is not performed, ldvTime must remain 0 (e.g., when we
- are doing retainer profiling).
- ldvTime is set to 1 in initLdvProfiling().
- ldvTime is set back to 0 in shutdownHaskell().
- In the meanwhile, ldvTime increments.
-*/
-nat ldvTime = 0;
-#
// ldvTimeSave is set in LdvCensusKillAll(), and stores the final number of
// times that LDV profiling was proformed.
static nat ldvTimeSave;
-// gi[] stores the statistics obtained at each heap census.
-// gi[0] is not used. See initLdvProfiling().
-LdvGenInfo *gi;
-
-#define giINCREMENT 32 // allocation unit for gi[]
-static nat giLength; // current length of gi[]
-
-// giMax is initialized to 2^LDV_SHIFT in initLdvProfiling().
-// When ldvTime reaches giMax, the profiling stops because a closure can
-// store only up to (giMax - 1) as its creation or last use time.
-static nat giMax;
-
/* --------------------------------------------------------------------------
* Fills in the slop when a *dynamic* closure changes its type.
* First calls LDV_recordDead() to declare the closure is dead, and then
void
LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
{
- if (ldvTime > 0) {
+ if (era > 0) {
StgInfoTable *inf = get_itbl((p));
nat nw, i;
switch (inf->type) {
}
/* --------------------------------------------------------------------------
- * Initialize gi[ldvTime].
- * ----------------------------------------------------------------------- */
-static inline void
-giInitForCurrentEra(void)
-{
- gi[ldvTime].notUsed = 0;
- gi[ldvTime].inherentlyUsed = 0;
- gi[ldvTime].used = 0;
-
- gi[ldvTime].voidNew = 0;
- gi[ldvTime].dragNew = 0;
-}
-
-/* --------------------------------------------------------------------------
- * Increases ldvTime by 1 and initialize gi[ldvTime].
- * Reallocates gi[] and increases its size if needed.
- * ----------------------------------------------------------------------- */
-static void
-incrementLdvTime( void )
-{
- ldvTime++;
-
- if (ldvTime == giMax) {
- fprintf(stderr,
- "Lag/Drag/Void profiling limit %u reached. "
- "Please increase the profiling interval with -L option.\n",
- giLength);
- barf("Current profiling interval = %f seconds",
- (float)RtsFlags.ProfFlags.profileInterval / 1000.0 );
- }
-
- if (ldvTime % giINCREMENT == 0) {
- gi = stgReallocBytes(gi, sizeof(LdvGenInfo) * (giLength + giINCREMENT),
- "incrementLdvTime");
- giLength += giINCREMENT;
- }
-
- // What a stupid bug I struggled against for such a long time! I
- // placed giInitForCurrentEra() before the above rellocation part,
- // and it cost me three hours!
- giInitForCurrentEra();
-}
-
-/* --------------------------------------------------------------------------
- * Initialization code for LDV profiling.
- * ----------------------------------------------------------------------- */
-void
-initLdvProfiling( void )
-{
- nat p;
-
- gi = stgMallocBytes(sizeof(LdvGenInfo) * giINCREMENT, "initLdvProfiling");
- giLength = giINCREMENT;
-
- ldvTime = 1; // turn on LDV profiling.
- giInitForCurrentEra();
-
- // giMax = 2^LDV_SHIFT
- giMax = 1;
- for (p = 0; p < LDV_SHIFT; p++)
- giMax *= 2;
-}
-
-/* --------------------------------------------------------------------------
- * This function must be called before f-closing prof_file.
- * Still hp_file is open; see endHeapProfiling() in ProfHeap.c.
- * ----------------------------------------------------------------------- */
-void
-endLdvProfiling( void )
-{
- nat t;
- int sumVoidNew, sumDragNew;
-
- // Now we compute voidTotal and dragTotal of each LdvGenInfo structure.
- sumVoidNew = 0;
- sumDragNew = 0;
- for (t = 0; t < ldvTimeSave; t++) {
- sumVoidNew += gi[t].voidNew;
- sumDragNew += gi[t].dragNew;
- gi[t].voidTotal = sumVoidNew;
- gi[t].dragTotal = sumDragNew;
- }
-
- // t = 0 is wrong (because ldvTime == 0 indicates LDV profiling is
- // turned off.
- for (t = 1;t < ldvTimeSave; t++) {
- fprintf(hp_file, "MARK %f\n", gi[t].time);
- fprintf(hp_file, "BEGIN_SAMPLE %f\n", gi[t].time);
- fprintf(hp_file, "VOID\t%u\n", gi[t].voidTotal * sizeof(StgWord));
- fprintf(hp_file, "LAG\t%u\n", (gi[t].notUsed - gi[t].voidTotal) * sizeof(StgWord));
- fprintf(hp_file, "USE\t%u\n", (gi[t].used - gi[t].dragTotal) * sizeof(StgWord));
- fprintf(hp_file, "INHERENT_USE\t%u\n", gi[t].inherentlyUsed * sizeof(StgWord));
- fprintf(hp_file, "DRAG\t%u\n", gi[t].dragTotal * sizeof(StgWord));
- fprintf(hp_file, "END_SAMPLE %f\n", gi[t].time);
- }
-}
-
-/* --------------------------------------------------------------------------
- * Print the statistics.
- * This function is called after each retainer profiling.
- * ----------------------------------------------------------------------- */
-static void
-outputLdvSet( void )
-{
-}
-
-/* --------------------------------------------------------------------------
- * This function is eventually called on every object in the heap
- * during a census. Any census is initiated immediately after a major
- * garbage collection, and we exploit this fact in the implementation.
- * If c is an 'inherently used' closure, gi[ldvTime].inherentlyUsed is
- * updated. If c is an ordinary closure, either gi[ldvTime].notUsed or
- * gi[ldvTime].used is updated.
- * ----------------------------------------------------------------------- */
-static inline nat
-processHeapClosure(StgClosure *c)
-{
- nat size;
- StgInfoTable *info;
-
- info = get_itbl(c);
-
- ASSERT(
- ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= ldvTime &&
- ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0
- );
- ASSERT(
- ((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
- (
- (LDVW(c) & LDV_LAST_MASK) <= ldvTime &&
- (LDVW(c) & LDV_LAST_MASK) > 0
- )
- );
-
- switch (info->type) {
- /*
- 'inherently used' cases: add to gi[ldvTime].inherentlyUsed
- */
-
- case TSO:
- size = tso_sizeW((StgTSO *)c);
- goto inherently_used;
-
- case MVAR:
- size = sizeofW(StgMVar);
- goto inherently_used;
-
- case MUT_ARR_PTRS:
- case MUT_ARR_PTRS_FROZEN:
- size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
- goto inherently_used;
-
- case ARR_WORDS:
- size = arr_words_sizeW((StgArrWords *)c);
- goto inherently_used;
-
- case WEAK:
- case MUT_VAR:
- case MUT_CONS:
- case FOREIGN:
- case BCO:
- case STABLE_NAME:
- size = sizeW_fromITBL(info);
- goto inherently_used;
-
- /*
- ordinary cases: add to gi[ldvTime].notUsed if c is not being used.
- add to gi[ldvTime].used if c is being used.
- */
- case THUNK:
- size = stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
- break;
-
- case THUNK_1_0:
- case THUNK_0_1:
- case THUNK_2_0:
- case THUNK_1_1:
- case THUNK_0_2:
- case THUNK_SELECTOR:
- size = sizeofW(StgHeader) + MIN_UPD_SIZE;
- break;
-
- case AP_UPD:
- case PAP:
- size = pap_sizeW((StgPAP *)c);
- break;
-
- case CONSTR:
- case CONSTR_1_0:
- case CONSTR_0_1:
- case CONSTR_2_0:
- case CONSTR_1_1:
- case CONSTR_0_2:
-
- case FUN:
- case FUN_1_0:
- case FUN_0_1:
- case FUN_2_0:
- case FUN_1_1:
- case FUN_0_2:
-
- case BLACKHOLE_BQ:
- case BLACKHOLE:
- case SE_BLACKHOLE:
- case CAF_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
- size = sizeW_fromITBL(info);
- break;
-
- case IND_PERM:
- size = sizeofW(StgInd);
- break;
-
- case IND_OLDGEN_PERM:
- size = sizeofW(StgIndOldGen);
- break;
-
- /*
- Error case
- */
- case IND: // IND cannot appear after major GCs.
- case IND_OLDGEN: // IND_OLDGEN cannot appear major GCs.
- case EVACUATED: // EVACUATED is encountered only during GCs.
- // static objects
- case IND_STATIC:
- case CONSTR_STATIC:
- case FUN_STATIC:
- case THUNK_STATIC:
- case CONSTR_INTLIKE:
- case CONSTR_CHARLIKE:
- case CONSTR_NOCAF_STATIC:
- // stack objects
- case UPDATE_FRAME:
- case CATCH_FRAME:
- case STOP_FRAME:
- case SEQ_FRAME:
- case RET_DYN:
- case RET_BCO:
- case RET_SMALL:
- case RET_VEC_SMALL:
- case RET_BIG:
- case RET_VEC_BIG:
- // others
- case BLOCKED_FETCH:
- case FETCH_ME:
- case FETCH_ME_BQ:
- case RBH:
- case REMOTE_REF:
- case INVALID_OBJECT:
- default:
- barf("Invalid object in processHeapClosure(): %d", info->type);
- return 0;
- }
-
- /*
- ordinary cases:
- We can compute either gi[ldvTime].notUsed or gi[ldvTime].used; the other
- can be computed from the total sum of costs.
- At the moment, we choose to compute gi[ldvTime].notUsed, which seems to
- be smaller than gi[ldvTime].used.
- */
-
- // ignore closures that don't satisfy our constraints.
- if (closureSatisfiesConstraints(c)) {
- if ((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE)
- gi[ldvTime].notUsed += size - sizeofW(StgProfHeader);
- else
- gi[ldvTime].used += size - sizeofW(StgProfHeader);
- }
- return size;
-
-inherently_used:
- // ignore closures that don't satisfy our constraints.
- if (closureSatisfiesConstraints(c)) {
- gi[ldvTime].inherentlyUsed += size - sizeofW(StgProfHeader);
- }
- return size;
-}
-
-/* --------------------------------------------------------------------------
- * Calls processHeapClosure() on every closure in the heap blocks
- * begining at bd during a census.
- * ----------------------------------------------------------------------- */
-static void
-processHeap( bdescr *bd )
-{
- StgPtr p;
- nat size;
-
- while (bd != NULL) {
- p = bd->start;
- while (p < bd->free) {
- size = processHeapClosure((StgClosure *)p);
- p += size;
- while (p < bd->free && !*p) // skip slop
- p++;
- }
- ASSERT(p == bd->free);
- bd = bd->link;
- }
-}
-
-/* --------------------------------------------------------------------------
- * Calls processHeapClosure() on every closure in the small object pool
- * during a census.
- * ----------------------------------------------------------------------- */
-static void
-processSmallObjectPool( void )
-{
- bdescr *bd;
- StgPtr p;
- nat size;
-
- bd = small_alloc_list;
-
- // first block
- if (bd == NULL)
- return;
-
- p = bd->start;
- while (p < alloc_Hp) {
- size = processHeapClosure((StgClosure *)p);
- p += size;
- while (p < alloc_Hp && !*p) // skip slop
- p++;
- }
- ASSERT(p == alloc_Hp);
-
- bd = bd->link;
- while (bd != NULL) {
- p = bd->start;
- while (p < bd->free) {
- size = processHeapClosure((StgClosure *)p);
- p += size;
- while (p < bd->free && !*p) // skip slop
- p++;
- }
- ASSERT(p == bd->free);
- bd = bd->link;
- }
-}
-
-/* --------------------------------------------------------------------------
- * Calls processHeapClosure() on every (large) closure in the object
- * chain beginning at bd during a census.
- * ----------------------------------------------------------------------- */
-static void
-processChain( bdescr *bd )
-{
- while (bd != NULL) {
- // bd->free - bd->start is not an accurate measurement of the
- // object size. Actually it is always zero, so we compute its
- // size explicitly.
- processHeapClosure((StgClosure *)bd->start);
- bd = bd->link;
- }
-}
-
-/* --------------------------------------------------------------------------
- * Starts a census for LDV profiling.
- * Invariants:
- * Any call to LdvCensus() is preceded by a major garbage collection.
- * ----------------------------------------------------------------------- */
-void
-LdvCensus( void )
-{
- nat g, s;
-
- // ldvTime == 0 means that LDV profiling is currently turned off.
- if (ldvTime == 0)
- return;
-
- stat_startLDV();
- //
- // Todo: when we perform LDV profiling, the Haskell mutator time seems to
- // be affected by -S or -s runtime option. For instance, the
- // following two options should result in nearly same
- // profiling outputs, but the second run (without -Sstderr
- // option) spends almost twice as long in the Haskell
- // mutator as the first run:
- //
- // 1) +RTS -Sstderr -hL -RTS
- // 2) +RTS -hL -RTS
- //
- // This is quite a subtle bug because this wierd phenomenon is not
- // observed in retainer profiling, yet mut_user_time_during_LDV() is
- // completely orthogonal to mut_user_time_during_RP(). However, the
- // overall shapes of the resultant graphs are almost the same.
- //
- gi[ldvTime].time = mut_user_time_during_LDV();
- if (RtsFlags.GcFlags.generations == 1) {
- //
- // Todo: support LDV for two-space garbage collection.
- //
- barf("Lag/Drag/Void profiling not supported with -G1");
- } else {
- for (g = 0; g < RtsFlags.GcFlags.generations; g++)
- for (s = 0; s < generations[g].n_steps; s++) {
- if (g == 0 && s == 0) {
- // after a major GC, the nursery must be empty,
- // and no need to call processNursery().
- ASSERT(MainCapability.r.rNursery->start ==
- MainCapability.r.rNursery->free);
- processSmallObjectPool();
- processChain(generations[g].steps[s].large_objects);
- } else{
- processHeap(generations[g].steps[s].blocks);
- processChain(generations[g].steps[s].large_objects);
- }
- }
- }
- outputLdvSet(); // output to hp_file
- stat_endLDV(); // output to prof_file
-
- incrementLdvTime();
-}
-
-/* --------------------------------------------------------------------------
* This function is called eventually on every object destroyed during
* a garbage collection, whether it is a major garbage collection or
* not. If c is an 'inherently used' closure, nothing happens. If c
info = get_itbl(c);
if (info->type != EVACUATED) {
- ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= ldvTime &&
+ ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
(
- (LDVW(c) & LDV_LAST_MASK) <= ldvTime &&
+ (LDVW(c) & LDV_LAST_MASK) <= era &&
(LDVW(c) & LDV_LAST_MASK) > 0
));
}
nat g, s;
// ldvTime == 0 means that LDV profiling is currently turned off.
- if (ldvTime == 0)
+ if (era == 0)
return;
if (RtsFlags.GcFlags.generations == 1) {
LdvCensusKillAll( void )
{
LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
-
- // record the time when LDV profiling stops.
- ldvTimeSave = ldvTime;
-
- // and, stops LDV profiling.
- ldvTime = 0;
}
#endif /* PROFILING */
/* -----------------------------------------------------------------------------
- * $Id: LdvProfile.h,v 1.1 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: LdvProfile.h,v 1.2 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
#include "ProfHeap.h"
-void LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p );
-
-// 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.
-//
-// Note: ldvTime is 0 if LDV profiling is turned off.
-// ldvTime is > 0 if LDV profiling is turned on.
-// size does not include StgProfHeader.
-//
-// Even though ldvTime is checked in both LdvCensusForDead() and
-// LdvCensusKillAll(), we still need to make sure that ldvTime 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.
-
-static inline void
-LDV_recordDead( StgClosure *c, nat size )
-{
- if (ldvTime > 0 && closureSatisfiesConstraints(c)) {
- nat t;
- size -= sizeofW(StgProfHeader);
- if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
- t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
- if (t < ldvTime) {
- gi[t].voidNew += (int)size;
- gi[ldvTime].voidNew -= (int)size;
- }
- } else {
- t = LDVW((c)) & LDV_LAST_MASK;
- if (t + 1 < ldvTime) {
- gi[t + 1].dragNew += size;
- gi[ldvTime].dragNew -= size;
- }
- }
- }
-}
-
-extern void initLdvProfiling ( void );
-extern void endLdvProfiling ( void );
-extern void LdvCensus ( void );
+extern void LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p );
extern void LdvCensusForDead ( nat );
extern void LdvCensusKillAll ( void );
+// Creates a 0-filled slop of size 'howManyBackwards' backwards from the
+// address 'from'.
+//
+// Invoked when:
+// 1) Hp is incremented and exceeds HpLim (in Updates.hc).
+// 2) copypart() is called (in GC.c).
+#define FILL_SLOP(from, howManyBackwards) \
+ if (era > 0) { \
+ int i; \
+ for (i = 0;i < (howManyBackwards); i++) \
+ ((StgWord *)(from))[-i] = 0; \
+ }
+
+// Informs the LDV profiler that closure c has just been evacuated.
+// Evacuated objects are no longer needed, so we just store its original size in
+// the LDV field.
+#define SET_EVACUAEE_FOR_LDV(c, size) \
+ LDVW((c)) = (size)
+
#endif /* PROFILING */
#endif /* LDVPROFILE_H */
/* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.26 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.27 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#include "StrHash.h"
#include "RetainerProfile.h"
#include "LdvProfile.h"
+#include "Arena.h"
#ifdef DEBUG_HEAP_PROF
#include "Printer.h"
-static void initSymbolHash(void);
-static void clear_table_data(void);
static void fprint_data(FILE *fp);
#endif
/* -----------------------------------------------------------------------------
- * Hash tables.
+ * era stores the current time period. It is the same as the
+ * number of censuses that have been performed.
*
- * For profiling by module, constructor or closure type we need to be
- * able to get from a string describing the category to a structure
- * containing the counters for that category. The strings aren't
- * unique (although gcc will do a fairly good job of commoning them up
- * where possible), so we have a many->one mapping.
- *
- * We represent the many->one mapping with a hash table. In order to
- * find the unique counter associated with a string the first time we
- * encounter a particular string, we need another hash table, mapping
- * hashed strings to buckets of counters. The string is hashed, then
- * the bucket is searched for an existing counter for the same
- * string.
+ * RESTRICTION:
+ * era must be no longer than LDV_SHIFT (15 or 30) bits.
+ * Invariants:
+ * era is initialized to 0 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;
-#ifdef PROFILING
-typedef struct _ctr {
- const char *str;
- unsigned long mem_resid;
- struct _ctr *next;
- struct _ctr *next_bucket;
-} prof_ctr;
-
-/* Linked list of all existing ctr structs */
-prof_ctr *all_ctrs;
-
-/* Hash table mapping (char *) -> (struct _ctr) */
-HashTable *str_to_ctr;
-
-/* Hash table mapping hash_t (hashed string) -> (struct _ctr) */
-HashTable *hashstr_to_ctrs;
+/* -----------------------------------------------------------------------------
+ counters
+ -------------------------------------------------------------------------- */
+typedef struct _counter {
+ void *identity;
+ union {
+ nat resid;
+ struct {
+ int prim; // total size of 'inherently used' closures
+ int unused; // total size of 'never used' closures
+ int used; // total size of 'used at least once' closures
+ int void_new; // current total size of 'destroyed without being used' closures
+ int drag_new; // current total size of 'used at least once and waiting to die'
+ } ldv;
+ } c;
+ struct _counter *next;
+} counter;
-static void
-initHashTables( void )
+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;
+
+Census *censuses = NULL;
+nat n_censuses = 0;
+
+/* --------------------------------------------------------------------------
+ * Profiling type predicates
+ * ----------------------------------------------------------------------- */
+#ifdef PROFILING
+static inline rtsBool
+doingLDVProfiling( void )
{
- str_to_ctr = allocHashTable();
- hashstr_to_ctrs = allocHashTable();
- all_ctrs = NULL;
+ return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
+ || RtsFlags.ProfFlags.bioSelector != NULL);
}
-static prof_ctr *
-strToCtr(const char *str)
+static inline rtsBool
+doingRetainerProfiling( void )
{
- prof_ctr *ctr;
-
- ctr = lookupHashTable( str_to_ctr, (W_)str );
-
- if (ctr != NULL) { return ctr; }
-
- else {
- hash_t str_hash = hash_str((char *)str);
- prof_ctr *prev;
+ return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
+ || RtsFlags.ProfFlags.retainerSelector != NULL);
+}
+#endif // PROFILING
- ctr = lookupHashTable( hashstr_to_ctrs, (W_)str_hash );
- prev = NULL;
+// 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.
- for (; ctr != NULL; prev = ctr, ctr = ctr->next_bucket ) {
- if (!strcmp(ctr->str, str)) {
- insertHashTable( str_to_ctr, (W_)str, ctr );
-#ifdef DEBUG_CTR
- fprintf(stderr,"strToCtr: existing ctr for `%s'\n",str);
-#endif
- return ctr;
+#ifdef PROFILING
+void
+LDV_recordDead( StgClosure *c, nat size )
+{
+ if (era > 0 && closureSatisfiesConstraints(c)) {
+ nat t;
+ size -= sizeofW(StgProfHeader);
+ if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
+ t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
+ if (t < era) {
+ censuses[t].void_total += (int)size;
+ censuses[era].void_total -= (int)size;
}
- }
-
- ctr = stgMallocBytes(sizeof(prof_ctr), "strToCtr");
- ctr->mem_resid = 0;
- ctr->str = str;
- ctr->next_bucket = NULL;
- ctr->next = all_ctrs;
- all_ctrs = ctr;
-
-#ifdef DEBUG_CTR
- fprintf(stderr,"strToCtr: new ctr for `%s'\n",str);
-#endif
-
- if (prev != NULL) {
- prev->next_bucket = ctr;
} else {
- insertHashTable( hashstr_to_ctrs, str_hash, ctr );
+ t = LDVW((c)) & LDV_LAST_MASK;
+ if (t + 1 < era) {
+ censuses[t + 1].drag_total += size;
+ censuses[era].drag_total -= size;
+ }
}
- insertHashTable( str_to_ctr, (W_)str, ctr);
- return ctr;
}
}
+#endif
-static void
-clearCtrResid( void )
+/* --------------------------------------------------------------------------
+ * Initialize censuses[era];
+ * ----------------------------------------------------------------------- */
+static inline void
+initEra(void)
{
- prof_ctr *ctr;
-
- for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
- ctr->mem_resid = 0;
- }
+ censuses[era].not_used = 0;
+ censuses[era].used = 0;
+ censuses[era].prim = 0;
+ censuses[era].void_total = 0;
+ censuses[era].drag_total = 0;
}
+/* --------------------------------------------------------------------------
+ * Increases era by 1 and initialize census[era].
+ * Reallocates gi[] and increases its size if needed.
+ * ----------------------------------------------------------------------- */
static void
-reportCtrResid(FILE *fp)
+nextEra( void )
{
- prof_ctr *ctr;
-
- for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
- if (ctr->mem_resid != 0) {
- fprintf(fp," %s %ld\n", ctr->str, ctr->mem_resid * sizeof(W_));
+#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();
}
-#endif /* PROFILING */
/* -------------------------------------------------------------------------- */
return 0;
}
+ // 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");
+
fprintf(hp_file, "JOB \"%s", prog_argv[0]);
#ifdef PROFILING
#ifdef DEBUG_HEAP_PROF
DEBUG_LoadSymbols(prog_argv[0]);
- initSymbolHash();
#endif
#ifdef PROFILING
- initHashTables();
+ if (doingRetainerProfiling()) {
+ initRetainerProfiling();
+ }
#endif
return 0;
}
#ifdef PROFILING
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_RETAINER:
+ if (doingRetainerProfiling()) {
endRetainerProfiling();
- break;
- case HEAP_BY_LDV:
- endLdvProfiling();
- break;
}
#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 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;
-
- for (i=0; i < SYMBOL_HASH_SIZE; i++) {
- symbol_hash[i].ptr = NULL;
- }
-}
-
-static nat
-lookup_symbol(void *addr)
-{
- nat orig_bucket = hash(addr);
- nat bucket;
+#ifdef PROFILING
+ // Note:
+ // We do not need to perform a major garbage collection because all the
+ // closures created since the last census will not affect the profiling
+ // statistics anyhow.
+ if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV)
+ LdvCensusKillAll();
+#endif
- 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");
+#ifdef PROFILING
+ // At last... we can output the census info for LDV profiling
+ if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
+ nat t;
+ int sumVoidNew, sumDragNew;
+
+ // Now we compute void_total and drag_total for each census
+ sumVoidNew = 0;
+ sumDragNew = 0;
+ for (t = 1; t < era; t++) { // note: start at 1, not 0
+ sumVoidNew += censuses[t].void_total;
+ sumDragNew += censuses[t].drag_total;
+ censuses[t].void_total = sumVoidNew;
+ censuses[t].drag_total = sumDragNew;
+ ASSERT( censuses[t].void_total < censuses[t].not_used );
+ ASSERT( censuses[t].drag_total < censuses[t].used );
}
- }
-
- symbol_hash[bucket].ptr = addr;
- lookupGHCName(addr,&symbol_hash[bucket].name);
- symbol_hash[bucket].data = 0;
- return bucket;
-}
-
-static void
-clear_table_data(void)
-{
- nat i;
-
- for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
- symbol_hash[i].data = 0;
- }
-}
-
-static void
-fprint_data(FILE *fp)
-{
- nat i;
- for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
- if (symbol_hash[i].data > 0) {
- fprintf(fp, " %s %lu\n", symbol_hash[i].name, (unsigned long)symbol_hash[i].data);
+
+ for (t = 1; t < era; t++) { // note: start at 1, not 0
+ fprintf(hp_file, "MARK %f\n", censuses[t].time);
+ fprintf(hp_file, "BEGIN_SAMPLE %f\n", censuses[t].time);
+ fprintf(hp_file, "VOID\t%u\n", censuses[t].void_total * sizeof(W_));
+ fprintf(hp_file, "LAG\t%u\n",
+ (censuses[t].not_used - censuses[t].void_total) * sizeof(W_));
+ fprintf(hp_file, "USE\t%u\n",
+ (censuses[t].used - censuses[t].drag_total) * sizeof(W_));
+ fprintf(hp_file, "INHERENT_USE\t%u\n",
+ censuses[t].prim * sizeof(W_));
+ fprintf(hp_file, "DRAG\t%u\n", censuses[t].drag_total * sizeof(W_));
+ fprintf(hp_file, "END_SAMPLE %f\n", censuses[t].time);
}
}
-}
+#endif
-static inline void
-add_data(void *addr, nat data)
-{
- symbol_hash[lookup_symbol(addr)].data += data;
+ 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 DEBUG_HEAP_PROF
/* -----------------------------------------------------------------------------
Closure Type Profiling;
PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
-------------------------------------------------------------------------- */
-static nat closure_types[N_CLOSURE_TYPES];
-
static char *type_names[] = {
"INVALID_OBJECT"
, "CONSTR"
, "EVACUATED"
};
-static void
-fprint_closure_types(FILE *fp)
-{
- nat i;
-
- for (i = 0; i < N_CLOSURE_TYPES; i++) {
- if (closure_types[i]) {
- fprintf(fp, " %s %lu\n", type_names[i], (unsigned long)closure_types[i]);
- }
- }
-}
-
#endif /* DEBUG_HEAP_PROF */
#ifdef PROFILING
static void
-clearCCSResid(CostCentreStack *ccs)
-{
- IndexTable *i;
-
- ccs->mem_resid = 0;
-
- for (i = ccs->indexTable; i != 0; i = i->next) {
- if (!i->back_edge) {
- clearCCSResid(i->ccs);
- }
- }
-}
-
-static void
fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
{
char buf[max_length+1];
fprintf(fp, "%s", buf);
}
-static void
-reportCCSResid(FILE *fp, CostCentreStack *ccs)
-{
- IndexTable *i;
-
- if (ccs->mem_resid != 0) {
- fprintf(fp," ");
- // print as much of the CCS as possible in 20 chars, ending with "..."
- fprint_ccs(fp,ccs,30);
- fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
- }
-
- for (i = ccs->indexTable; i != 0; i = i->next) {
- if (!i->back_edge) {
- reportCCSResid(fp,i->ccs);
- }
- }
-}
-
static rtsBool
str_matches_selector( char* str, char* sel )
{
RtsFlags.ProfFlags.ccSelector );
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 = str_matches_selector( rs->element[i]->cc->label,
+ RtsFlags.ProfFlags.retainerSelector );
+ if (b) return rtsTrue;
+ }
+ }
+ return rtsFalse;
+ }
return rtsTrue;
}
#endif /* PROFILING */
/* -----------------------------------------------------------------------------
+ * Print out the results of a heap census.
+ * -------------------------------------------------------------------------- */
+static void
+dumpCensus( Census *census )
+{
+ counter *ctr;
+
+#ifdef PROFILING
+ // We can't generate any info for LDV profiling until
+ // the end of the run...
+ if (doingLDVProfiling()) { return; }
+#endif
+
+ fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", census->time);
+
+ for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
+
+#ifdef DEBUG_HEAP_PROF
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
+ case HEAP_BY_INFOPTR:
+ fprint_data(hp_file);
+ break;
+ case HEAP_BY_CLOSURE_TYPE:
+ fprint_closure_types(hp_file);
+ break;
+ }
+#endif
+
+#ifdef PROFILING
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
+ case HEAP_BY_CCS:
+ fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, 30);
+ 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;
+
+ // 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", ctr->c.resid * sizeof(W_));
+ }
+
+ fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
+}
+
+/* -----------------------------------------------------------------------------
* Code to perform a heap census.
* -------------------------------------------------------------------------- */
static void
-heapCensusChain( bdescr *bd )
+heapCensusChain( Census *census, bdescr *bd )
{
StgPtr p;
StgInfoTable *info;
+ void *identity;
nat size;
-#ifdef PROFILING
+ counter *ctr;
nat real_size;
-#endif
+ 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 BCO:
case FUN:
case THUNK:
case IND_PERM:
case SE_BLACKHOLE:
case BLACKHOLE:
case BLACKHOLE_BQ:
- case WEAK:
- case FOREIGN:
- case STABLE_NAME:
- case MVAR:
- case MUT_VAR:
- case MUT_CONS:
case CONSTR_INTLIKE:
case CONSTR_CHARLIKE:
case FUN_1_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:
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;
barf("heapCensus");
}
+ identity = NULL;
+
#ifdef DEBUG_HEAP_PROF
+ real_size = size;
switch (RtsFlags.ProfFlags.doHeapProfile) {
case HEAP_BY_INFOPTR:
- add_data((void *)(*p), size * sizeof(W_));
+ identity = (void *)((StgClosure *)p)->header.info;
break;
case HEAP_BY_CLOSURE_TYPE:
- closure_types[info->type] += size * sizeof(W_);
+ identity = type_names[info->type];
break;
+ default:
+ barf("heapCensus; doHeapProfile");
}
#endif
if (closureSatisfiesConstraints((StgClosure*)p)) {
switch (RtsFlags.ProfFlags.doHeapProfile) {
case HEAP_BY_CCS:
- ((StgClosure *)p)->header.prof.ccs->mem_resid += real_size;
+ identity = ((StgClosure *)p)->header.prof.ccs;
break;
case HEAP_BY_MOD:
- strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
- ->mem_resid += real_size;
+ identity = ((StgClosure *)p)->header.prof.ccs->cc->module;
break;
case HEAP_BY_DESCR:
- strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
- += real_size;
+ identity = (get_itbl((StgClosure *)p))->prof.closure_desc;
break;
case HEAP_BY_TYPE:
- strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
- += real_size;
+ identity = (get_itbl((StgClosure *)p))->prof.closure_type;
+ break;
+ case HEAP_BY_RETAINER:
+ identity = retainerSetOf((StgClosure *)p);
break;
+ case 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;
+ // NOTE: don't break here. We're not using the
+ // hash table.
+ p += size;
+ continue;
default:
barf("heapCensus; doHeapProfile");
}
}
#endif
+
+ if (identity != NULL) {
+ ctr = lookupHashTable( census->hash, (StgWord)identity );
+ if (ctr != NULL) {
+ ctr->c.resid += real_size;
+ } else {
+ ctr = arenaAlloc( census->arena, sizeof(counter) );
+ insertHashTable( census->hash, (StgWord)identity, ctr );
+ ctr->c.resid = real_size;
+ ctr->identity = identity;
+ ctr->next = census->ctrs;
+ census->ctrs = ctr;
+ }
+ }
+
p += size;
}
}
void
heapCensus( void )
{
- StgDouble time;
nat g, s;
-
-#ifdef DEBUG_HEAP_PROF
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_INFOPTR:
- clear_table_data();
- break;
- case HEAP_BY_CLOSURE_TYPE:
-#if 0
-# error fix me
- memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
-#endif
- break;
- default:
- return;
- }
-#endif
+ Census *census;
+
+ stat_startHeapCensus();
+ census = &censuses[era];
+ census->time = mut_user_time();
+ census->hash = allocHashTable();
+ census->ctrs = NULL;
+ census->arena = newArena();
+
+ // calculate retainer sets if necessary
#ifdef PROFILING
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case NO_HEAP_PROFILING:
- return;
- case HEAP_BY_CCS:
- /* zero all the residency counters */
- clearCCSResid(CCS_MAIN);
- break;
- case HEAP_BY_MOD:
- case HEAP_BY_DESCR:
- case HEAP_BY_TYPE:
- clearCtrResid();
- break;
- default:
- barf("heapCensus; doHeapProfile");
+ if (doingRetainerProfiling()) {
+ retainerProfile();
}
#endif
- time = mut_user_time_during_GC();
- fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
-
+ // traverse the heap, collecting the census info
+ heapCensusChain( census, small_alloc_list );
if (RtsFlags.GcFlags.generations == 1) {
- heapCensusChain( g0s0->to_blocks );
+ heapCensusChain( census, g0s0->to_blocks );
} else {
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (s = 0; s < generations[g].n_steps; s++) {
- heapCensusChain( generations[g].steps[s].blocks );
+ 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 );
}
}
}
-#ifdef DEBUG_HEAP_PROF
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_INFOPTR:
- fprint_data(hp_file);
- break;
- case HEAP_BY_CLOSURE_TYPE:
- fprint_closure_types(hp_file);
- break;
- }
-#endif
-
-#ifdef PROFILING
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_CCS:
- reportCCSResid(hp_file,CCS_MAIN);
- break;
- case HEAP_BY_MOD:
- case HEAP_BY_DESCR:
- case HEAP_BY_TYPE:
- reportCtrResid(hp_file);
- break;
- default:
- barf("heapCensus; doHeapProfile");
- }
-#endif
+ // dump out the census info
+ dumpCensus( census );
+
+ // free our storage
+ freeHashTable(census->hash, NULL/* don't free the elements */);
+ arenaFree(census->arena);
+
+ // we're into the next time period now
+ nextEra();
- fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
+ stat_endHeapCensus();
}
#endif /* PROFILING || DEBUG_HEAP_PROF */
/* -----------------------------------------------------------------------------
- * $Id: ProfHeap.h,v 1.2 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: ProfHeap.h,v 1.3 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
*
* ---------------------------------------------------------------------------*/
+#ifndef PROFHEAP_H
+#define PROFHEAP_H
extern void heapCensus( void );
extern nat initHeapProfiling( void );
extern void endHeapProfiling( void );
extern rtsBool closureSatisfiesConstraints( StgClosure* p );
+extern void LDV_recordDead( StgClosure *c, nat size );
+
+#endif
/* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.26 2001/11/22 16:33:06 simonmar Exp $
+ * $Id: Profiling.c,v 1.27 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
/* cost centres are registered by the per-module
* initialisation code now...
*/
-
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_RETAINER:
- initRetainerProfiling();
- break;
- case HEAP_BY_LDV:
- initLdvProfiling();
- break;
- }
}
void
/* -----------------------------------------------------------------------------
- * $Id: RetainerProfile.c,v 1.1 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: RetainerProfile.c,v 1.2 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
pointer. See retainerSetOf().
*/
-// extract the retainer set field from c
-#define RSET(c) ((c)->header.prof.hp.rs)
-
-static StgWord flip = 0; // flip bit
+StgWord flip = 0; // flip bit
// must be 0 if DEBUG_RETAINER is on (for static closures)
-#define isRetainerSetFieldValid(c) \
- ((((StgWord)(c)->header.prof.hp.rs & 1) ^ flip) == 0)
-
#define setRetainerSetToNull(c) \
(c)->header.prof.hp.rs = (RetainerSet *)((StgWord)NULL | flip)
}
}
-static inline RetainerSet *
-retainerSetOf( StgClosure *c )
-{
- ASSERT( isRetainerSetFieldValid(c) );
- // StgWord has the same size as pointers, so the following type
- // casting is okay.
- return (RetainerSet *)((StgWord)RSET(c) ^ flip);
-}
-
-/* -----------------------------------------------------------------------------
- * Returns the cost of the closure *c, e.g., the amount of heap memory
- * allocated to *c. Static objects cost 0.
- * The cost includes even the words allocated for profiling purpose.
- * Cf. costPure().
- * -------------------------------------------------------------------------- */
-static inline nat
-cost( StgClosure *c )
-{
- StgInfoTable *info;
-
- info = get_itbl(c);
- switch (info->type) {
- case TSO:
- return tso_sizeW((StgTSO *)c);
-
- case THUNK:
- case THUNK_1_0:
- case THUNK_0_1:
- case THUNK_2_0:
- case THUNK_1_1:
- case THUNK_0_2:
- return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
-
- // static objects
- case CONSTR_STATIC:
- case FUN_STATIC:
- case THUNK_STATIC:
- return 0;
-
- case MVAR:
- return sizeofW(StgMVar);
-
- case MUT_ARR_PTRS:
- case MUT_ARR_PTRS_FROZEN:
- return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
-
- case AP_UPD:
- case PAP:
- return pap_sizeW((StgPAP *)c);
-
- case ARR_WORDS:
- return arr_words_sizeW((StgArrWords *)c);
-
- case CONSTR:
- case CONSTR_1_0:
- case CONSTR_0_1:
- case CONSTR_2_0:
- case CONSTR_1_1:
- case CONSTR_0_2:
- case FUN:
- case FUN_1_0:
- case FUN_0_1:
- case FUN_2_0:
- case FUN_1_1:
- case FUN_0_2:
- case WEAK:
- case MUT_VAR:
- case MUT_CONS:
- case CAF_BLACKHOLE:
- case BLACKHOLE:
- case SE_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
- case BLACKHOLE_BQ:
- case IND_PERM:
- case IND_OLDGEN:
- case IND_OLDGEN_PERM:
- case FOREIGN:
- case BCO:
- case STABLE_NAME:
- return sizeW_fromITBL(info);
-
- case THUNK_SELECTOR:
- return sizeofW(StgHeader) + MIN_UPD_SIZE;
-
- /*
- Error case
- */
- // IND_STATIC cannot be *c, *cp, *r in the retainer profiling loop.
- case IND_STATIC:
- // CONSTR_INTLIKE, CONSTR_CHARLIKE, and CONSTR_NOCAF_STATIC
- // cannot be *c, *cp, *r in the retainer profiling loop.
- case CONSTR_INTLIKE:
- case CONSTR_CHARLIKE:
- case CONSTR_NOCAF_STATIC:
- // Stack objects are invalid because they are never treated as
- // legal objects during retainer profiling.
- case UPDATE_FRAME:
- case CATCH_FRAME:
- case STOP_FRAME:
- case SEQ_FRAME:
- case RET_DYN:
- case RET_BCO:
- case RET_SMALL:
- case RET_VEC_SMALL:
- case RET_BIG:
- case RET_VEC_BIG:
- // other cases
- case IND:
- case BLOCKED_FETCH:
- case FETCH_ME:
- case FETCH_ME_BQ:
- case RBH:
- case REMOTE_REF:
- case EVACUATED:
- case INVALID_OBJECT:
- default:
- barf("Invalid object in cost(): %d", get_itbl(c)->type);
- }
-}
-
-/* -----------------------------------------------------------------------------
- * Returns the pure cost of the closure *c, i.e., the size of memory
- * allocated for this object without profiling.
- * Note & Todo:
- * costPure() subtracts the overhead incurred by profiling for all types
- * of objects except TSO. Even though the overhead in the TSO object
- * itself is taken into account, the additional costs due to larger
- * stack objects (with unnecessary retainer profiling fields) is not
- * considered. Still, costPure() should result in an accurate estimate
- * of heap use because stacks in TSO objects are allocated in large blocks.
- * If we get rid of the (currently unused) retainer profiling field in
- * all stack objects, the result will be accurate.
- * ------------------------------------------------------------------------- */
-static inline nat
-costPure( StgClosure *c )
-{
- nat cst;
-
- if (!closureSatisfiesConstraints(c)) {
- return 0;
- }
-
- cst = cost(c);
-
- ASSERT(cst == 0 || cst - sizeofW(StgProfHeader) > 0);
-
- if (cst > 0) {
- return cst - sizeofW(StgProfHeader);
- } else {
- return 0;
- }
-}
-
/* -----------------------------------------------------------------------------
* Returns rtsTrue if *c is a retainer.
* -------------------------------------------------------------------------- */
* Depending on the definition of this function, the maintenance of retainer
* sets can be made easier. If most retainer sets are likely to be created
* again across garbage collections, refreshAllRetainerSet() in
- * RetainerSet.c can simply set the cost field of each retainer set.
+ * RetainerSet.c can simply do nothing.
* If this is not the case, we can free all the retainer sets and
* re-initialize the hash table.
* See refreshAllRetainerSet() in RetainerSet.c.
* s != NULL
* -------------------------------------------------------------------------- */
static inline void
-associate( StgClosure *c, RetainerSet *rsOfc, RetainerSet *s )
+associate( StgClosure *c, RetainerSet *s )
{
- nat cost_c;
-
- cost_c = costPure(c); // not cost(c)
- if (rsOfc != NULL) {
- ASSERT(rsOfc->cost >= cost_c);
- rsOfc->cost -= cost_c;
- }
// StgWord has the same size as pointers, so the following type
// casting is okay.
RSET(c) = (RetainerSet *)((StgWord)s | flip);
- s->cost += cost_c;
}
/* -----------------------------------------------------------------------------
numObjectVisited++;
if (s == NULL)
- associate(c, NULL, singleton(R_r));
+ associate(c, singleton(R_r));
else
// s is actually the retainer set of *c!
- associate(c, NULL, s);
+ associate(c, s);
// compute c_child_r
c_child_r = isRetainer(c) ? c : r;
goto loop; // no need to process child
if (s == NULL)
- associate(c, retainerSetOfc, addElement(R_r, retainerSetOfc));
+ associate(c, addElement(R_r, retainerSetOfc));
else {
// s is not NULL and cp is not a retainer. This means that
// each time *cp is visited, so is *c. Thus, if s has
// exactly one more element in its retainer set than c, s
// is also the new retainer set for *c.
if (s->num == retainerSetOfc->num + 1) {
- associate(c, retainerSetOfc, s);
+ associate(c, s);
}
// Otherwise, just add R_r to the current retainer set of *c.
else {
- associate(c, retainerSetOfc, addElement(R_r, retainerSetOfc));
+ associate(c, addElement(R_r, retainerSetOfc));
}
}
void
retainerProfile(void)
{
- nat allCost, numSet;
#ifdef DEBUG_RETAINER
nat i;
nat totalHeapSize; // total raw heap size (computed by linear scanning)
#endif
computeRetainerSet();
- outputRetainerSet(hp_file, &allCost, &numSet);
-
#ifdef DEBUG_RETAINER
fprintf(stderr, "After traversing:\n");
sumOfCostLinear = 0;
#ifdef DEBUG_RETAINER
maxCStackSize, maxStackSize,
#endif
- (double)timesAnyObjectVisited / numObjectVisited,
- allCost, numSet);
+ (double)timesAnyObjectVisited / numObjectVisited);
}
/* -----------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
- * $Id: RetainerProfile.h,v 1.1 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: RetainerProfile.h,v 1.2 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
#ifdef PROFILING
+#include "RetainerSet.h"
+
extern void initRetainerProfiling ( void );
extern void endRetainerProfiling ( void );
extern void printRetainer ( FILE *, retainer );
extern void retainerProfile ( void );
extern void resetStaticObjectForRetainerProfiling ( void );
+extern StgWord flip;
+
+// extract the retainer set field from c
+#define RSET(c) ((c)->header.prof.hp.rs)
+
+#define isRetainerSetFieldValid(c) \
+ ((((StgWord)(c)->header.prof.hp.rs & 1) ^ flip) == 0)
+
+static inline RetainerSet *
+retainerSetOf( StgClosure *c )
+{
+ ASSERT( isRetainerSetFieldValid(c) );
+ // StgWord has the same size as pointers, so the following type
+ // casting is okay.
+ return (RetainerSet *)((StgWord)RSET(c) ^ flip);
+}
+
// firstStack is exported because memInventory() in Schedule.c uses it.
#ifdef DEBUG
extern bdescr *firstStack;
/* -----------------------------------------------------------------------------
- * $Id: RetainerSet.c,v 1.1 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: RetainerSet.c,v 1.2 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
#ifdef PROFILING
#include "Rts.h"
+#include "RtsFlags.h"
#include "Stats.h"
#include "RtsUtils.h"
#include "RetainerSet.h"
* -------------------------------------------------------------------------- */
RetainerSet rs_MANY = {
num : 0,
- cost : 0,
hashKey : 0,
link : NULL,
id : 1,
element : {}
};
-nat maxRetainerSetSize = 16;
-
/* -----------------------------------------------------------------------------
* calculate the size of a RetainerSet structure
* -------------------------------------------------------------------------- */
void
refreshAllRetainerSet(void)
{
+#ifdef FIRST_APPROACH
int i;
- // Choose one of the following two approaches.
-
-#ifdef FIRST_APPROACH
// first approach: completely refresh
arenaFree(arena);
arena = newArena();
hashTable[i] = NULL;
nextId = 2;
#endif // FIRST_APPROACH
-
-#ifdef SECOND_APPROACH
- // second approach: leave all the retainer sets for reuse
- RetainerSet *rs;
- for (i = 0;i < HASH_TABLE_SIZE; i++) {
- rs = hashTable[i];
- while (rs != NULL) {
- rs->cost = 0;
- rs = rs->link;
- }
- }
- rs_MANY.cost = 0;
-#endif // SECOND_APPROACH
}
/* -----------------------------------------------------------------------------
// create it
rs = arenaAlloc( arena, sizeofRetainerSet(1) );
rs->num = 1;
- rs->cost = 0;
rs->hashKey = hk;
rs->link = hashTable[hash(hk)];
rs->id = nextId++;
#endif
ASSERT(rs != NULL);
- ASSERT(rs->num <= maxRetainerSetSize);
+ ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize);
- if (rs == &rs_MANY || rs->num == maxRetainerSetSize) {
+ if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) {
return &rs_MANY;
}
// create a new retainer set
nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) );
nrs->num = rs->num + 1;
- nrs->cost = 0;
nrs->hashKey = hk;
nrs->link = hashTable[hash(hk)];
nrs->id = nextId++;
#endif /* SECOND_APPROACH */
/* -----------------------------------------------------------------------------
- * Print the statistics. This function is called after each
- * retainer profiling. *allCost is set the sum of all costs retained
- * by any retainer sets. *numSet is set to the number of all
- * retainer sets (including those with 0 cost).
- * -------------------------------------------------------------------------- */
-void
-outputRetainerSet( FILE *hp_file, nat *allCost, nat *numSet )
-{
- nat i;
-#ifdef FIRST_APPROACH
- nat j;
-#endif
- RetainerSet *rs;
- double duration;
-
- *allCost = 0;
- *numSet = 0;
- duration = mut_user_time_during_RP();
-
- fprintf(hp_file, "MARK %f\n", duration);
- fprintf(hp_file, "BEGIN_SAMPLE %f\n", duration);
-
- if (rs_MANY.cost > 0) {
- fprintf(hp_file, "MANY\t%u\n", rs_MANY.cost * sizeof(StgWord));
- }
-
- for (i = 0; i < HASH_TABLE_SIZE; i++) {
- for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
- (*numSet)++;
- /*
- Note: If rs->cost is 0, it means that there exists at
- least one object which is retained by this retainer set
- *rs temporarily. Since its new retainer set of this
- object (replacing *rs) is at least larger than *rs, if
- the cost of every object was a positive quantity, the
- following invariants would hold: If rs->cost == 0, there
- exists a retainer set rs' such that rs'->cost > 0 and
- rs'->num > rs->num. However, static objects cost zero,
- this does not hold. If we set the cost of each static
- object to a positive quantity, it should hold, which is
- actually the case.
- */
- if (rs->cost == 0)
- continue;
-
- *allCost += rs->cost;
-
-#ifdef SECOND_APPROACH
- if (rs->id > 0) // if having a positive cost for the first time?
- rs->id = -(rs->id); // mark as having a positive cost
- // Now, this retainer set has a permanent negative id.
-
- // report in the unit of bytes: * sizeof(StgWord)
- printRetainerSetShort(hp_file, rs);
- fprintf(hp_file, "\t%u\n", rs->cost * sizeof(StgWord));
-#endif
-
-#ifdef FIRST_APPROACH
- fprintf(hp_file, "{");
- for (j = 0; j < rs->num - 1; j++) {
- printRetainer(hp_file, rs->element[j]);
- fprintf(hp_file, ",");
- }
- printRetainer(hp_file, rs->element[j]);
- fprintf(hp_file, "}\t%u\n", rs->cost * sizeof(StgWord));
-#endif
- }
- }
- fprintf(hp_file, "END_SAMPLE %f\n", duration);
-}
-
-/*
- This function is called at the exit of the program.
- */
+ * Dump the contents of each retainer set into the log file at the end
+ * of the run, so the user can find out for a given retainer set ID
+ * the full contents of that set.
+ * --------------------------------------------------------------------------- */
#ifdef SECOND_APPROACH
void
outputAllRetainerSet(FILE *prof_file)
/* -----------------------------------------------------------------------------
- * $Id: RetainerSet.h,v 1.1 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: RetainerSet.h,v 1.2 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
*
* ---------------------------------------------------------------------------*/
+#ifndef RETAINERSET_H
+#define RETAINERSET_H
+
#ifdef PROFILING
/*
+ Type 'retainer' defines the retainer identity.
+
+ Invariant:
+ 1. The retainer identity of a given retainer cannot change during
+ program execution, no matter where it is actually stored.
+ For instance, the memory address of a retainer cannot be used as
+ its retainer identity because its location may change during garbage
+ collections.
+ 2. Type 'retainer' must come with comparison operations as well as
+ an equality operation. That it, <, >, and == must be supported -
+ this is necessary to store retainers in a sorted order in retainer sets.
+ Therefore, you cannot use a huge structure type as 'retainer', for instance.
+
+ We illustrate three possibilities of defining 'retainer identity'.
+ Choose one of the following three compiler directives:
+
+ Retainer scheme 1 (RETAINER_SCHEME_INFO) : retainer = info table
+ Retainer scheme 2 (RETAINER_SCHEME_CCS) : retainer = cost centre stack
+ Retainer scheme 3 (RETAINER_SCHEME_CC) : retainer = cost centre
+*/
+
+// #define RETAINER_SCHEME_INFO
+#define RETAINER_SCHEME_CCS
+// #define RETAINER_SCHEME_CC
+
+#ifdef RETAINER_SCHEME_INFO
+struct _StgInfoTable;
+typedef struct _StgInfoTable *retainer;
+#endif
+
+#ifdef RETAINER_SCHEME_CCS
+typedef CostCentreStack *retainer;
+#endif
+
+#ifdef RETAINER_SCHEME_CC
+typedef CostCentre *retainer;
+#endif
+
+/*
+ Type 'retainerSet' defines an abstract datatype for sets of retainers.
+
+ Invariants:
+ A retainer set stores its elements in increasing order (in element[] array).
+ */
+
+typedef struct _RetainerSet {
+ nat num; // number of elements
+ StgWord hashKey; // hash key for this retainer set
+ struct _RetainerSet *link; // link to the next retainer set in the bucket
+ int id; // unique id of this retainer set (used when printing)
+ // Its absolute value is interpreted as its true id; if id is
+ // negative, it indicates that this retainer set has had a postive
+ // cost after some retainer profiling.
+ retainer element[0]; // elements of this retainer set
+ // do not put anything below here!
+} RetainerSet;
+
+/*
Note:
There are two ways of maintaining all retainer sets. The first is simply by
freeing all the retainer sets and re-initialize the hash table at each
// the best place to define it.
void printRetainer(FILE *, retainer);
-#endif /* PROFILING */
-
+#endif // PROFILING
+#endif // RETAINERSET_H
/* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.52 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.53 2001/11/26 16:54:21 simonmar Exp $
*
* (c) The AQUA Project, Glasgow University, 1994-1997
* (c) The GHC Team, 1998-1999
RtsFlags.ProfFlags.doHeapProfile = rtsFalse;
RtsFlags.ProfFlags.profileInterval = 20;
RtsFlags.ProfFlags.showCCSOnException = rtsFalse;
+ RtsFlags.ProfFlags.maxRetainerSetSize = 8;
RtsFlags.ProfFlags.modSelector = NULL;
RtsFlags.ProfFlags.descrSelector = NULL;
RtsFlags.ProfFlags.typeSelector = NULL;
RtsFlags.ProfFlags.ccSelector = NULL;
+ RtsFlags.ProfFlags.retainerSelector = NULL;
+ RtsFlags.ProfFlags.bioSelector = NULL;
#elif defined(DEBUG)
RtsFlags.ProfFlags.doHeapProfile = rtsFalse;
# if defined(PROFILING)
"",
-" -hx Heap residency profile (XML) (output file <program>.prof)",
-" -h<break-down> Heap residency profile (text) (output file <program>.prof)",
-" break-down: C = cost centre stack (default), M = module",
-" D = closure description, Y = type description",
-" -hR Retainer profile (output files <program>.hp)",
-" -hL Lag/Drag/Void/Use profile (output files <program>.hp)",
+" -hx Heap residency profile (XML) (output file <program>.prof)",
+" -h<break-down> Heap residency profile (hp2ps) (output file <program>.hp)",
+" break-down: c = cost centre stack (default)",
+" m = module",
+" d = closure description",
+" y = type description",
+" r = retainer",
+" b = biography (LAG,DRAG,VOID,USE)",
" A subset of closures may be selected thusly:",
-" -hc{cc, cc ...} specific cost centre(s) (NOT STACKS!)",
+" -hc{cc,cc ...} specific cost centre(s) (NOT STACKS!)",
" -hm{mod,mod...} all cost centres from the specified modules(s)",
" -hd{des,des...} closures with specified closure descriptions",
" -hy{typ,typ...} closures with specified type descriptions",
+" -hr{cc,cc...} closures with specified retainers",
+" -hb{bio,bio...} closures with specified biographies (lag,drag,void,use)",
+"",
+" -R<size> Set the maximum retainer set size (default: 8)",
"",
" -i<msec> Time between heap samples (msec, default: 20)",
"",
}
) break;
+ case 'R':
+ PROFILING_BUILD_ONLY(
+ RtsFlags.ProfFlags.maxRetainerSetSize = atof(rts_argv[arg]+2);
+
+ if (RtsFlags.ProfFlags.maxRetainerSetSize < 0)
+ bad_option( rts_argv[arg] );
+ break;
+ ) break;
+
case 'h': /* serial heap profile */
#if !defined(PROFILING) && defined(DEBUG)
switch (rts_argv[arg][2]) {
#else
PROFILING_BUILD_ONLY(
switch (rts_argv[arg][2]) {
- case '\0':
- case 'C':
- if (RtsFlags.ProfFlags.doHeapProfile == 0) {
- RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS;
- break;
- } else {
- goto many_hps;
- }
- case 'M':
- if (RtsFlags.ProfFlags.doHeapProfile == 0) {
+ case '\0':
+ case 'C':
+ case 'c':
+ case 'M':
+ case 'm':
+ case 'D':
+ case 'd':
+ case 'Y':
+ case 'y':
+ case 'R':
+ case 'r':
+ case 'B':
+ case 'b':
+ if (rts_argv[arg][2] != '\0' && rts_argv[arg][3] != '\0') {
+ {
+ char *left = strchr(rts_argv[arg], '{');
+ char *right = strrchr(rts_argv[arg], '}');
+ if (! left || ! right ||
+ strrchr(rts_argv[arg], '{') != left ||
+ strchr(rts_argv[arg], '}') != right) {
+ prog_belch(
+ "Invalid heap profiling selection bracketing\n %s\n",
+ rts_argv[arg]);
+ error = rtsTrue;
+ } else {
+ *right = '\0';
+ switch (rts_argv[arg][2]) {
+ case 'C':
+ case 'c': // cost centre label select
+ RtsFlags.ProfFlags.ccSelector = left + 1;
+ break;
+ case 'M':
+ case 'm': // cost centre module select
+ RtsFlags.ProfFlags.modSelector = left + 1;
+ break;
+ case 'D':
+ case 'd': // closure descr select
+ RtsFlags.ProfFlags.descrSelector = left + 1;
+ break;
+ case 'Y':
+ case 'y': // closure type select
+ RtsFlags.ProfFlags.typeSelector = left + 1;
+ break;
+ case 'R':
+ case 'r': // retainer select
+ RtsFlags.ProfFlags.retainerSelector = left + 1;
+ break;
+ case 'B':
+ case 'b': // biography select
+ RtsFlags.ProfFlags.bioSelector = left + 1;
+ break;
+ }
+ }
+ }
+ break;
+ }
+
+ if (RtsFlags.ProfFlags.doHeapProfile != 0) {
+ prog_belch("multiple heap profile options");
+ error = rtsTrue;
+ break;
+ }
+
+ switch (rts_argv[arg][2]) {
+ case '\0':
+ case 'C':
+ case 'c':
+ RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS;
+ break;
+ case 'M':
+ case 'm':
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
break;
- } else {
- goto many_hps;
- }
- case 'D':
- if (RtsFlags.ProfFlags.doHeapProfile == 0) {
+ case 'D':
+ case 'd':
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
break;
- } else {
- goto many_hps;
- }
- case 'Y':
- if (RtsFlags.ProfFlags.doHeapProfile == 0) {
+ case 'Y':
+ case 'y':
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
break;
- } else {
- goto many_hps;
- }
- case 'R':
- if (RtsFlags.ProfFlags.doHeapProfile == 0) {
+ case 'R':
+ case 'r':
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_RETAINER;
break;
- } else {
- goto many_hps;
- }
- case 'L':
- if (RtsFlags.ProfFlags.doHeapProfile == 0) {
+ case 'B':
+ case 'b':
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_LDV;
break;
- } else {
- goto many_hps;
- }
- many_hps:
- prog_belch("multiple heap profile options");
- error = rtsTrue;
- break;
+ }
+ break;
- case 'c': /* cost centre label select */
- case 'm': /* cost centre module select */
- case 'd': /* closure descr select */
- case 'y': /* closure type select */
- {char *left = strchr(rts_argv[arg], '{');
- char *right = strrchr(rts_argv[arg], '}');
- if (! left || ! right ||
- strrchr(rts_argv[arg], '{') != left ||
- strchr(rts_argv[arg], '}') != right) {
- prog_belch(
- "Invalid heap profiling selection bracketing\n %s\n",
- rts_argv[arg]);
- error = rtsTrue;
- } else {
- *right = '\0';
- switch (rts_argv[arg][2]) {
- case 'c': /* cost centre label select */
- RtsFlags.ProfFlags.ccSelector = left + 1;
- break;
- case 'm': /* cost centre module select */
- RtsFlags.ProfFlags.modSelector = left + 1;
- break;
- case 'd': /* closure descr select */
- RtsFlags.ProfFlags.descrSelector = left + 1;
- break;
- case 'y': /* closure type select */
- RtsFlags.ProfFlags.typeSelector = left + 1;
- break;
- }
- }
- }
- break;
- default:
+ default:
prog_belch("invalid heap profile option: %s",rts_argv[arg]);
error = rtsTrue;
}
)
-
-#endif
+#endif // PROFILING
break;
#if defined(PROFILING)
/* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.56 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.57 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
/* start timing the shutdown */
stat_startExit();
-#ifdef PROFILING
- // @LDV profiling
- //
- // Note:
- // We do not need to perform a major garbage collection because all the
- // closures created since the last census will not affect the profiling
- // statistics anyhow.
- //
- // Note:
- // We ignore any object created afterwards.
- // finalizeWeakPointersNow() may corrupt the heap (because it executes
- // rts_evalIO(), which adds an initial evaluation stack again).
- // Thus, we call LdvCensusKillAll() here, and prohibit LDV profiling
- // afterwards.
- // Acutally, it is pointless to call LdvCensusKillAll() any later because
- // no object created later will be taken into account for profiling.
- if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV)
- LdvCensusKillAll();
-#endif
-
#if !defined(GRAN)
/* Finalize any remaining weak pointers */
finalizeWeakPointersNow();
/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.107 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: Schedule.c,v 1.108 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#include "Proftimer.h"
#include "ProfHeap.h"
#include "RetainerProfile.h"
-#include "LdvProfile.h"
#endif
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h"
#ifdef PROFILING
if (RtsFlags.ProfFlags.profileInterval==0 || performHeapProfile) {
- if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
- //
- // Note: currently retainer profiling is performed after
- // a major garbage collection.
- //
- GarbageCollect(GetRoots, rtsTrue);
- retainerProfile();
- } else if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
- //
- // We have LdvCensus() preceded by a major garbage
- // collection because we don't want *genuinely* dead
- // closures to be involved in LDV profiling. Another good
- // reason is to produce consistent profiling results
- // regardless of the interval at which GCs are performed.
- // In other words, we want LDV profiling results to be
- // completely independent of the GC interval.
- //
- GarbageCollect(GetRoots, rtsTrue);
- LdvCensus();
- } else {
- //
- // Normal creator-based heap profile
- //
- GarbageCollect(GetRoots, rtsTrue);
- heapCensus();
- }
+ GarbageCollect(GetRoots, rtsTrue);
+ heapCensus();
performHeapProfile = rtsFalse;
ready_to_gc = rtsFalse; // we already GC'd
}
/* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.38 2001/11/25 16:59:11 sof Exp $
+ * $Id: Stats.c,v 1.39 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
static TICK_TYPE RP_start_time = 0, RP_tot_time = 0; /* retainer prof user time */
static TICK_TYPE RPe_start_time = 0, RPe_tot_time = 0; /* retainer prof elap time */
-static TICK_TYPE LDV_start_time = 0, LDV_tot_time = 0; /* LDV prof user time */
-static TICK_TYPE LDVe_start_time = 0, LDVe_tot_time = 0; /* LDV prof elap time */
+static TICK_TYPE HC_start_time, HC_tot_time = 0; // heap census prof user time
+static TICK_TYPE HCe_start_time, HCe_tot_time = 0; // heap census prof elap time
#endif
#ifdef PROFILING
double
mut_user_time_during_GC( void )
{
- return TICK_TO_DBL(GC_start_time - GC_tot_time - PROF_VAL(RP_tot_time - LDV_tot_time));
+ return TICK_TO_DBL(GC_start_time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
}
double
mut_user_time( void )
{
getTimes();
- return TICK_TO_DBL(CurrentUserTime - GC_tot_time - PROF_VAL(RP_tot_time - LDV_tot_time));
+ return TICK_TO_DBL(CurrentUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
}
#ifdef PROFILING
/*
mut_user_time_during_RP() is similar to mut_user_time_during_GC();
it returns the MUT time during retainer profiling.
- The same is for mut_user_time_during_LDV();
+ The same is for mut_user_time_during_HC();
*/
double
mut_user_time_during_RP( void )
{
- return TICK_TO_DBL(RP_start_time - GC_tot_time - RP_tot_time - LDV_tot_time);
+ return TICK_TO_DBL(RP_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
}
double
-mut_user_time_during_LDV( void )
+mut_user_time_during_heap_census( void )
{
- return TICK_TO_DBL(LDV_start_time - GC_tot_time - RP_tot_time - LDV_tot_time);
+ return TICK_TO_DBL(HC_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
}
#endif /* PROFILING */
#ifdef SMP
MutUserTime = CurrentUserTime;
#else
- MutUserTime = CurrentUserTime - GC_tot_time - PROF_VAL(RP_tot_time - LDV_tot_time) - InitUserTime;
+ MutUserTime = CurrentUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
if (MutUserTime < 0) { MutUserTime = 0; }
#endif
}
#ifdef SMP
ExitUserTime = CurrentUserTime - MutUserTime;
#else
- ExitUserTime = CurrentUserTime - MutUserTime - GC_tot_time - PROF_VAL(RP_tot_time - LDV_tot_time) - InitUserTime;
+ ExitUserTime = CurrentUserTime - MutUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
#endif
ExitElapsedTime = CurrentElapsedTime - MutElapsedStamp;
if (ExitUserTime < 0) {
nat maxCStackSize,
int maxStackSize,
#endif
- double averageNumVisit,
- nat allCost,
- nat numSet)
+ double averageNumVisit)
{
getTimes();
RP_tot_time += CurrentUserTime - RP_start_time;
fprintf(prof_file, "\tMax auxiliary stack size = %u\n", maxStackSize);
#endif
fprintf(prof_file, "\tAverage number of visits per object = %f\n", averageNumVisit);
- fprintf(prof_file, "\tCurrent total costs in bytes = %u\n", allCost * sizeof(StgWord));
- fprintf(prof_file, "\tNumber of retainer sets = %u\n\n", numSet);
}
#endif /* PROFILING */
/* -----------------------------------------------------------------------------
- Called at the beginning of each LDV Profiliing
+ Called at the beginning of each heap census
-------------------------------------------------------------------------- */
#ifdef PROFILING
void
-stat_startLDV(void)
+stat_startHeapCensus(void)
{
getTimes();
- LDV_start_time = CurrentUserTime;
- LDVe_start_time = CurrentElapsedTime;
+ HC_start_time = CurrentUserTime;
+ HCe_start_time = CurrentElapsedTime;
}
#endif /* PROFILING */
/* -----------------------------------------------------------------------------
- Called at the end of each LDV Profiliing
+ Called at the end of each heap census
-------------------------------------------------------------------------- */
#ifdef PROFILING
void
-stat_endLDV(void)
+stat_endHeapCensus(void)
{
getTimes();
- LDV_tot_time += CurrentUserTime - LDV_start_time;
- LDVe_tot_time += CurrentElapsedTime - LDVe_start_time;
+ HC_tot_time += CurrentUserTime - HC_start_time;
+ HCe_tot_time += CurrentElapsedTime - HCe_start_time;
}
#endif /* PROFILING */
fprintf(sf, " GC time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
#ifdef PROFILING
- if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
- fprintf(sf, " RP time %6.2fs (%6.2fs elapsed)\n",
- TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
- if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV)
- fprintf(sf, " LDV time %6.2fs (%6.2fs elapsed)\n",
- TICK_TO_DBL(LDV_tot_time), TICK_TO_DBL(LDVe_tot_time));
+ fprintf(sf, " RP time %6.2fs (%6.2fs elapsed)\n",
+ TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
+ fprintf(sf, " PROF time %6.2fs (%6.2fs elapsed)\n",
+ TICK_TO_DBL(HC_tot_time), TICK_TO_DBL(HCe_tot_time));
#endif
fprintf(sf, " EXIT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(ExitUserTime), TICK_TO_DBL(ExitElapsedTime));
TICK_TO_DBL(GC_tot_time)*100/TICK_TO_DBL(time),
TICK_TO_DBL(GCe_tot_time)*100/TICK_TO_DBL(etime));
- if (time - GC_tot_time - PROF_VAL(RP_tot_time - LDV_tot_time) == 0)
+ if (time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) == 0)
ullong_format_string(0, temp, rtsTrue/*commas*/);
else
ullong_format_string(
(ullong)((GC_tot_alloc*sizeof(W_))/
TICK_TO_DBL(time - GC_tot_time -
- PROF_VAL(RP_tot_time - LDV_tot_time))),
+ PROF_VAL(RP_tot_time + HC_tot_time))),
temp, rtsTrue/*commas*/);
fprintf(sf, " Alloc rate %s bytes per MUT second\n\n", temp);
fprintf(sf, " Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
TICK_TO_DBL(time - GC_tot_time -
- PROF_VAL(RP_tot_time - LDV_tot_time) - InitUserTime) * 100
+ PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100
/ TICK_TO_DBL(time),
TICK_TO_DBL(time - GC_tot_time -
- PROF_VAL(RP_tot_time - LDV_tot_time) - InitUserTime) * 100
+ PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100
/ TICK_TO_DBL(etime));
}
/* -----------------------------------------------------------------------------
- * $Id: Stats.h,v 1.13 2001/11/23 10:27:58 simonmar Exp $
+ * $Id: Stats.h,v 1.14 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#ifdef DEBUG_RETAINER
nat, int,
#endif
- double, nat, nat);
-
-extern void stat_startLDV(void);
-extern void stat_endLDV(void);
+ double);
#endif // PROFILING
+#if defined(PROFILING) || defined(DEBUG)
+extern void stat_startHeapCensus(void);
+extern void stat_endHeapCensus(void);
+#endif
+
extern void stat_startExit(void);
extern void stat_endExit(void);
#ifdef PROFILING
extern double mut_user_time_during_RP(void);
-extern double mut_user_time_during_LDV(void);
+extern double mut_user_time_during_heap_census(void);
#endif // PROFILING
extern void statDescribeGens( void );
/* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.54 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: Storage.c,v 1.55 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
/* -----------------------------------------------------------------------------
- * $Id: Weak.c,v 1.19 2001/11/22 14:25:13 simonmar Exp $
+ * $Id: Weak.c,v 1.20 2001/11/26 16:54:22 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
while ((w = weak_ptr_list)) {
weak_ptr_list = w->link;
if (w->header.info != &stg_DEAD_WEAK_info) {
- // @LDV profiling
- // Even thought the info type of w changes, we DO NOT perform any
- // LDV profiling because at this moment, LDV profiling must already
- // have been terminated. See the comments in shutdownHaskell().
- // At any rate, there is no need to call LDV_recordDead() because
- // weak pointers are inherently used.
-#ifdef PROFILING
- ASSERT(ldvTime == 0); // LDV profiling is turned off.
-#endif
w->header.info = &stg_DEAD_WEAK_info;
IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key));
if (w->finalizer != &stg_NO_FINALIZER_closure) {
projects / ghc-hetmet.git / commitdiff