X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRetainerProfile.c;h=5684468fd87c11695325c8d98f139afa690a3bff;hb=e030a747f89512121e582d302986ff6732ebb0c6;hp=f811d73aab4c6b03bedca3e80093aaa07e5b79b8;hpb=db61851c5472bf565cd1da900b33d6e033fd743d;p=ghc-hetmet.git diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c index f811d73..5684468 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.5 2002/07/18 09:12:35 simonmar Exp $ * * (c) The GHC Team, 2001 * Author: Sungwoo Park @@ -10,6 +10,8 @@ #ifdef PROFILING +#include + #include "Rts.h" #include "RtsUtils.h" #include "RetainerProfile.h" @@ -21,6 +23,7 @@ #include "RtsFlags.h" #include "Weak.h" #include "Sanity.h" +#include "StablePriv.h" #include "Profiling.h" #include "Stats.h" #include "BlockAlloc.h" @@ -54,20 +57,14 @@ 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) -static void retainStack(StgClosure *, StgClosure *, StgClosure *, StgPtr, StgPtr); -static void retainClosure(StgClosure *, StgClosure *, StgClosure *); +static void retainStack(StgClosure *, retainer, StgClosure *, StgPtr, StgPtr); +static void retainClosure(StgClosure *, StgClosure *, retainer); #ifdef DEBUG_RETAINER static void belongToHeap(StgPtr p); #endif @@ -141,7 +138,7 @@ typedef struct { typedef struct { StgClosure *c; - StgClosure *c_child_r; + retainer c_child_r; stackPos info; } stackElement; @@ -350,7 +347,7 @@ find_srt( stackPos *info ) * Note: SRTs are considered to be children as well. * -------------------------------------------------------------------------- */ static inline void -push( StgClosure *c, StgClosure *c_child_r, StgClosure **first_child ) +push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) { stackElement se; bdescr *nbd; // Next Block Descriptor @@ -666,7 +663,7 @@ popOff(void) { * is empty. * -------------------------------------------------------------------------- */ static inline void -pop( StgClosure **c, StgClosure **cp, StgClosure **r ) +pop( StgClosure **c, StgClosure **cp, retainer *r ) { stackElement *se; @@ -870,167 +867,12 @@ 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. * -------------------------------------------------------------------------- */ static inline rtsBool isRetainer( StgClosure *c ) { - if (get_itbl(c)->prof.closure_desc != NULL && !strcmp(get_itbl(c)->prof.closure_desc,"PCS")) { return rtsTrue; } - switch (get_itbl(c)->type) { // // True case @@ -1149,7 +991,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 +1021,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; } /* ----------------------------------------------------------------------------- @@ -1215,7 +1049,7 @@ associate( StgClosure *c, RetainerSet *rsOfc, RetainerSet *s ) * retainClosure() is invoked instead of evacuate(). * -------------------------------------------------------------------------- */ static void -retainStack( StgClosure *c, StgClosure *c_child_r, +retainStack( StgClosure *c, retainer c_child_r, StgClosure *stackOptionalFun, StgPtr stackStart, StgPtr stackEnd ) { @@ -1401,16 +1235,16 @@ retainStack( StgClosure *c, StgClosure *c_child_r, * *c0 can be TSO (as well as PAP and AP_UPD). * -------------------------------------------------------------------------- */ static void -retainClosure( StgClosure *c0, StgClosure *cp0, StgClosure *r0 ) +retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 ) { // c = Current closure // cp = Current closure's Parent // r = current closures' most recent Retainer // c_child_r = current closure's children's most recent retainer // first_child = first child of c - StgClosure *c, *cp, *r, *c_child_r, *first_child; + StgClosure *c, *cp, *first_child; RetainerSet *s, *retainerSetOfc; - retainer R_r; + retainer r, c_child_r; StgWord typeOfc; #ifdef DEBUG_RETAINER @@ -1558,7 +1392,6 @@ inner_loop: s = retainerSetOf(cp); // (c, cp, r, s) is available. - R_r = getRetainerFrom(r); // (c, cp, r, s, R_r) is available, so compute the retainer set for *c. if (retainerSetOfc == NULL) { @@ -1566,31 +1399,31 @@ inner_loop: numObjectVisited++; if (s == NULL) - associate(c, NULL, singleton(R_r)); + associate(c, singleton(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; + c_child_r = isRetainer(c) ? getRetainerFrom(c) : r; } else { // This is not the first visit to *c. - if (isMember(R_r, retainerSetOfc)) + if (isMember(r, retainerSetOfc)) goto loop; // no need to process child if (s == NULL) - associate(c, retainerSetOfc, addElement(R_r, retainerSetOfc)); + associate(c, addElement(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, retainerSetOfc)); } } @@ -1657,7 +1490,11 @@ retainRoot( StgClosure **tl ) ASSERT(isEmptyRetainerStack()); currentStackBoundary = stackTop; - retainClosure(*tl, *tl, *tl); + if (isRetainer(*tl)) { + retainClosure(*tl, *tl, getRetainerFrom(*tl)); + } else { + retainClosure(*tl, *tl, CCS_SYSTEM); + } // NOT TRUE: ASSERT(isMember(getRetainerFrom(*tl), retainerSetOf(*tl))); // *tl might be a TSO which is ThreadComplete, in which @@ -1689,6 +1526,9 @@ computeRetainerSet( void ) // retainRoot((StgClosure *)weak); retainRoot((StgClosure **)&weak); + // Consider roots from the stable ptr table. + markStablePtrTable(retainRoot); + // The following code resets the rs field of each unvisited mutable // object (computing sumOfNewCostExtra and updating costArray[] when // debugging retainer profiler). @@ -1846,7 +1686,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 +1762,6 @@ retainerProfile(void) #endif computeRetainerSet(); - outputRetainerSet(hp_file, &allCost, &numSet); - #ifdef DEBUG_RETAINER fprintf(stderr, "After traversing:\n"); sumOfCostLinear = 0; @@ -1978,8 +1815,7 @@ retainerProfile(void) #ifdef DEBUG_RETAINER maxCStackSize, maxStackSize, #endif - (double)timesAnyObjectVisited / numObjectVisited, - allCost, numSet); + (double)timesAnyObjectVisited / numObjectVisited); } /* -----------------------------------------------------------------------------