From dbef766ce79e37a74468a07a93b15ba1f06fe8f8 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 26 Nov 2001 16:54:22 +0000 Subject: [PATCH] [project @ 2001-11-26 16:54:21 by simonmar] 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, 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. --- ghc/includes/Closures.h | 4 +- ghc/includes/Constants.h | 4 +- ghc/includes/RtsFlags.h | 11 +- ghc/includes/Stg.h | 3 +- ghc/includes/StgLdvProf.h | 89 +----- ghc/includes/StgProf.h | 4 +- ghc/includes/StgRetainerProf.h | 75 ----- ghc/rts/GC.c | 4 +- ghc/rts/LdvProfile.c | 466 +--------------------------- ghc/rts/LdvProfile.h | 62 ++-- ghc/rts/ProfHeap.c | 667 +++++++++++++++++++++------------------- ghc/rts/ProfHeap.h | 7 +- ghc/rts/Profiling.c | 11 +- ghc/rts/RetainerProfile.c | 191 +----------- ghc/rts/RetainerProfile.h | 21 +- ghc/rts/RetainerSet.c | 107 +------ ghc/rts/RetainerSet.h | 67 +++- ghc/rts/RtsFlags.c | 189 +++++++----- ghc/rts/RtsStartup.c | 22 +- ghc/rts/Schedule.c | 31 +- ghc/rts/Stats.c | 62 ++-- ghc/rts/Stats.h | 14 +- ghc/rts/Storage.c | 2 +- ghc/rts/Weak.c | 11 +- 24 files changed, 666 insertions(+), 1458 deletions(-) delete mode 100644 ghc/includes/StgRetainerProf.h diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h index 0f413b5..93dfb30 100644 --- a/ghc/includes/Closures.h +++ b/ghc/includes/Closures.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -22,7 +22,7 @@ typedef struct { CostCentreStack *ccs; union { - RetainerSet *rs; // Retainer Set + struct _RetainerSet *rs; // Retainer Set StgWord ldvw; // Lag/Drag/Void Word } hp; } StgProfHeader; diff --git a/ghc/includes/Constants.h b/ghc/includes/Constants.h index ec20df6..9d66642 100644 --- a/ghc/includes/Constants.h +++ b/ghc/includes/Constants.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -144,7 +144,7 @@ -------------------------------------------------------------------------- */ /* 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 diff --git a/ghc/includes/RtsFlags.h b/ghc/includes/RtsFlags.h index 301743a..344b657 100644 --- a/ghc/includes/RtsFlags.h +++ b/ghc/includes/RtsFlags.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -97,22 +97,19 @@ struct PROFILING_FLAGS { # 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) diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h index 2fbcfc8..f6a74df 100644 --- a/ghc/includes/Stg.h +++ b/ghc/includes/Stg.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -158,7 +158,6 @@ typedef StgWord64 LW_; /* Profiling information */ #include "StgProf.h" -#include "StgRetainerProf.h" #include "StgLdvProf.h" /* Storage format definitions */ diff --git a/ghc/includes/StgLdvProf.h b/ghc/includes/StgLdvProf.h index 7ece731..dceefd7 100644 --- a/ghc/includes/StgLdvProf.h +++ b/ghc/includes/StgLdvProf.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -11,53 +11,6 @@ #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). @@ -78,6 +31,13 @@ extern LdvGenInfo *gi; #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. // @@ -86,38 +46,19 @@ extern LdvGenInfo *gi; // 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 diff --git a/ghc/includes/StgProf.h b/ghc/includes/StgProf.h index 825c846..194a228 100644 --- a/ghc/includes/StgProf.h +++ b/ghc/includes/StgProf.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -39,7 +39,6 @@ typedef struct _CostCentreStack { unsigned long time_ticks; unsigned long long mem_alloc; - unsigned long mem_resid; unsigned long inherited_ticks; unsigned long long inherited_alloc; @@ -184,7 +183,6 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ scc_count : 0, \ time_ticks : 0, \ mem_alloc : 0, \ - mem_resid : 0, \ inherited_ticks : 0, \ inherited_alloc : 0, \ root : 0, \ diff --git a/ghc/includes/StgRetainerProf.h b/ghc/includes/StgRetainerProf.h deleted file mode 100644 index 2b77772..0000000 --- a/ghc/includes/StgRetainerProf.h +++ /dev/null @@ -1,75 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $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 */ diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 8a9e2ac..d0d035c 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -1320,7 +1320,6 @@ copy(StgClosure *src, nat size, step *stp) 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); @@ -1364,7 +1363,6 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) 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 diff --git a/ghc/rts/LdvProfile.c b/ghc/rts/LdvProfile.c index 59a758f..c0f0411 100644 --- a/ghc/rts/LdvProfile.c +++ b/ghc/rts/LdvProfile.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -22,42 +22,10 @@ #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 @@ -76,7 +44,7 @@ static nat giMax; 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) { @@ -114,424 +82,6 @@ LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p ) } /* -------------------------------------------------------------------------- - * 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 @@ -549,11 +99,11 @@ processHeapClosureForDead( StgClosure *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 )); } @@ -813,7 +363,7 @@ LdvCensusForDead( nat N ) 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) { @@ -846,12 +396,6 @@ void LdvCensusKillAll( void ) { LdvCensusForDead(RtsFlags.GcFlags.generations - 1); - - // record the time when LDV profiling stops. - ldvTimeSave = ldvTime; - - // and, stops LDV profiling. - ldvTime = 0; } #endif /* PROFILING */ diff --git a/ghc/rts/LdvProfile.h b/ghc/rts/LdvProfile.h index b722fbc..106e0e2 100644 --- a/ghc/rts/LdvProfile.h +++ b/ghc/rts/LdvProfile.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -15,49 +15,29 @@ #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 */ diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c index fc4f421..21e83e5 100644 --- a/ghc/rts/ProfHeap.c +++ b/ghc/rts/ProfHeap.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -27,126 +27,154 @@ #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 */ /* -------------------------------------------------------------------------- */ @@ -175,6 +203,27 @@ initHeapProfiling(void) 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 @@ -201,11 +250,12 @@ initHeapProfiling(void) #ifdef DEBUG_HEAP_PROF DEBUG_LoadSymbols(prog_argv[0]); - initSymbolHash(); #endif #ifdef PROFILING - initHashTables(); + if (doingRetainerProfiling()) { + initRetainerProfiling(); + } #endif return 0; @@ -221,120 +271,67 @@ endHeapProfiling(void) } #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" @@ -393,37 +390,11 @@ static char *type_names[] = { , "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]; @@ -468,25 +439,6 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length) 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 ) { @@ -537,32 +489,113 @@ closureSatisfiesConstraints( StgClosure* p ) 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: @@ -572,12 +605,6 @@ heapCensusChain( bdescr *bd ) 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: @@ -596,6 +623,17 @@ heapCensusChain( bdescr *bd ) 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: @@ -608,15 +646,18 @@ heapCensusChain( bdescr *bd ) 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; @@ -624,14 +665,19 @@ heapCensusChain( bdescr *bd ) 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 @@ -642,25 +688,51 @@ heapCensusChain( bdescr *bd ) 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; } } @@ -669,83 +741,50 @@ heapCensusChain( bdescr *bd ) 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 */ diff --git a/ghc/rts/ProfHeap.h b/ghc/rts/ProfHeap.h index 852a828..70d5ea0 100644 --- a/ghc/rts/ProfHeap.h +++ b/ghc/rts/ProfHeap.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -7,8 +7,13 @@ * * ---------------------------------------------------------------------------*/ +#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 diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index da6ad0b..0050856 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -194,15 +194,6 @@ initProfiling1 (void) /* 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 diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c index f811d73..8561756 100644 --- a/ghc/rts/RetainerProfile.c +++ b/ghc/rts/RetainerProfile.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -54,15 +54,9 @@ static nat timesAnyObjectVisited; // number of times any objects are visited 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) @@ -870,159 +864,6 @@ maybeInitRetainerSet( StgClosure *c ) } } -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. * -------------------------------------------------------------------------- */ @@ -1149,7 +990,7 @@ isRetainer( StgClosure *c ) * 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. @@ -1179,19 +1020,11 @@ getRetainerFrom( StgClosure *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; } /* ----------------------------------------------------------------------------- @@ -1566,10 +1399,10 @@ inner_loop: 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; @@ -1579,18 +1412,18 @@ inner_loop: 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)); } } @@ -1846,7 +1679,6 @@ resetStaticObjectForRetainerProfiling( void ) void retainerProfile(void) { - nat allCost, numSet; #ifdef DEBUG_RETAINER nat i; nat totalHeapSize; // total raw heap size (computed by linear scanning) @@ -1923,8 +1755,6 @@ retainerProfile(void) #endif computeRetainerSet(); - outputRetainerSet(hp_file, &allCost, &numSet); - #ifdef DEBUG_RETAINER fprintf(stderr, "After traversing:\n"); sumOfCostLinear = 0; @@ -1978,8 +1808,7 @@ retainerProfile(void) #ifdef DEBUG_RETAINER maxCStackSize, maxStackSize, #endif - (double)timesAnyObjectVisited / numObjectVisited, - allCost, numSet); + (double)timesAnyObjectVisited / numObjectVisited); } /* ----------------------------------------------------------------------------- diff --git a/ghc/rts/RetainerProfile.h b/ghc/rts/RetainerProfile.h index 7a2f0fb..51ddc64 100644 --- a/ghc/rts/RetainerProfile.h +++ b/ghc/rts/RetainerProfile.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -13,12 +13,31 @@ #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; diff --git a/ghc/rts/RetainerSet.c b/ghc/rts/RetainerSet.c index 709555a..83e0d9f 100644 --- a/ghc/rts/RetainerSet.c +++ b/ghc/rts/RetainerSet.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -11,6 +11,7 @@ #ifdef PROFILING #include "Rts.h" +#include "RtsFlags.h" #include "Stats.h" #include "RtsUtils.h" #include "RetainerSet.h" @@ -40,15 +41,12 @@ static int nextId; // id of next retainer set * -------------------------------------------------------------------------- */ RetainerSet rs_MANY = { num : 0, - cost : 0, hashKey : 0, link : NULL, id : 1, element : {} }; -nat maxRetainerSetSize = 16; - /* ----------------------------------------------------------------------------- * calculate the size of a RetainerSet structure * -------------------------------------------------------------------------- */ @@ -80,11 +78,9 @@ initializeAllRetainerSet(void) 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(); @@ -93,19 +89,6 @@ refreshAllRetainerSet(void) 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 } /* ----------------------------------------------------------------------------- @@ -133,7 +116,6 @@ singleton(retainer r) // create it rs = arenaAlloc( arena, sizeofRetainerSet(1) ); rs->num = 1; - rs->cost = 0; rs->hashKey = hk; rs->link = hashTable[hash(hk)]; rs->id = nextId++; @@ -168,9 +150,9 @@ addElement(retainer r, RetainerSet *rs) #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; } @@ -213,7 +195,6 @@ addElement(retainer r, RetainerSet *rs) // 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++; @@ -447,80 +428,10 @@ printRetainerSetShort(FILE *f, retainerSet *rs) #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) diff --git a/ghc/rts/RetainerSet.h b/ghc/rts/RetainerSet.h index feed43e..5b6a5b2 100644 --- a/ghc/rts/RetainerSet.h +++ b/ghc/rts/RetainerSet.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -8,9 +8,70 @@ * * ---------------------------------------------------------------------------*/ +#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 @@ -135,5 +196,5 @@ void outputAllRetainerSet(FILE *); // the best place to define it. void printRetainer(FILE *, retainer); -#endif /* PROFILING */ - +#endif // PROFILING +#endif // RETAINERSET_H diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c index e23346b..54511ed 100644 --- a/ghc/rts/RtsFlags.c +++ b/ghc/rts/RtsFlags.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -252,10 +252,13 @@ void initRtsFlagsDefaults(void) 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; @@ -414,17 +417,23 @@ usage_text[] = { # if defined(PROFILING) "", -" -hx Heap residency profile (XML) (output file .prof)", -" -h Heap residency profile (text) (output file .prof)", -" break-down: C = cost centre stack (default), M = module", -" D = closure description, Y = type description", -" -hR Retainer profile (output files .hp)", -" -hL Lag/Drag/Void/Use profile (output files .hp)", +" -hx Heap residency profile (XML) (output file .prof)", +" -h Heap residency profile (hp2ps) (output file .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 Set the maximum retainer set size (default: 8)", "", " -i Time between heap samples (msec, default: 20)", "", @@ -823,6 +832,15 @@ error = rtsTrue; } ) 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]) { @@ -840,93 +858,104 @@ error = rtsTrue; #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) diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index 69de672..438304a 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -277,26 +277,6 @@ shutdownHaskell(void) /* 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(); diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 256aab9..b027115 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,5 +1,5 @@ /* --------------------------------------------------------------------------- - * $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 * @@ -99,7 +99,6 @@ #include "Proftimer.h" #include "ProfHeap.h" #include "RetainerProfile.h" -#include "LdvProfile.h" #endif #if defined(GRAN) || defined(PAR) # include "GranSimRts.h" @@ -1278,32 +1277,8 @@ schedule( void ) #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 } diff --git a/ghc/rts/Stats.c b/ghc/rts/Stats.c index c96f63c..4b26990 100644 --- a/ghc/rts/Stats.c +++ b/ghc/rts/Stats.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -101,8 +101,8 @@ static TICK_TYPE GCe_start_time = 0, GCe_tot_time = 0; /* Elapsed GC time */ 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 @@ -227,32 +227,32 @@ getTimes(void) 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 */ @@ -366,7 +366,7 @@ stat_startExit(void) #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 } @@ -378,7 +378,7 @@ stat_endExit(void) #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) { @@ -529,9 +529,7 @@ stat_endRP( nat maxCStackSize, int maxStackSize, #endif - double averageNumVisit, - nat allCost, - nat numSet) + double averageNumVisit) { getTimes(); RP_tot_time += CurrentUserTime - RP_start_time; @@ -544,34 +542,32 @@ stat_endRP( 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 */ @@ -704,12 +700,10 @@ stat_exit(int alloc) 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)); @@ -719,23 +713,23 @@ stat_exit(int alloc) 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)); } diff --git a/ghc/rts/Stats.h b/ghc/rts/Stats.h index 061d5fb..59fe58a 100644 --- a/ghc/rts/Stats.h +++ b/ghc/rts/Stats.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -20,12 +20,14 @@ extern void stat_endRP(nat, #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); @@ -39,7 +41,7 @@ extern double mut_user_time(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 ); diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index ee8cfd8..51af3c8 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * diff --git a/ghc/rts/Weak.c b/ghc/rts/Weak.c index c80cf8c..ef26e3b 100644 --- a/ghc/rts/Weak.c +++ b/ghc/rts/Weak.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -36,15 +36,6 @@ finalizeWeakPointersNow(void) 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) { -- 1.7.10.4