diff options
Diffstat (limited to 'rts/LdvProfile.c')
| -rw-r--r-- | rts/LdvProfile.c | 342 |
1 files changed, 342 insertions, 0 deletions
diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c new file mode 100644 index 0000000000..19ebe426d3 --- /dev/null +++ b/rts/LdvProfile.c @@ -0,0 +1,342 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2001 + * Author: Sungwoo Park + * + * Lag/Drag/Void profiling. + * + * ---------------------------------------------------------------------------*/ + +#ifdef PROFILING + +#include "Rts.h" +#include "LdvProfile.h" +#include "RtsFlags.h" +#include "Profiling.h" +#include "Stats.h" +#include "Storage.h" +#include "RtsUtils.h" +#include "Schedule.h" + +/* -------------------------------------------------------------------------- + * Fills in the slop when a *dynamic* closure changes its type. + * First calls LDV_recordDead() to declare the closure is dead, and then + * fills in the slop. + * + * Invoked when: + * 1) blackholing, UPD_BH_UPDATABLE() and UPD_BH_SINGLE_ENTRY (in + * includes/StgMacros.h), threadLazyBlackHole() and + * threadSqueezeStack() (in GC.c). + * 2) updating with indirection closures, updateWithIndirection() + * and updateWithPermIndirection() (in Storage.h). + * + * LDV_recordDead_FILL_SLOP_DYNAMIC() is not called on 'inherently used' + * closures such as TSO. It is not called on PAP because PAP is not updatable. + * ----------------------------------------------------------------------- */ +void +LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p ) +{ + nat size, i; + +#if defined(__GNUC__) && __GNUC__ < 3 && defined(DEBUG) +#error Please use gcc 3.0+ to compile this file with DEBUG; gcc < 3.0 miscompiles it +#endif + + if (era > 0) { + // very like FILL_SLOP(), except that we call LDV_recordDead(). + size = closure_sizeW(p); + + LDV_recordDead((StgClosure *)(p), size); + + if (size > sizeofW(StgThunkHeader)) { + for (i = 0; i < size - sizeofW(StgThunkHeader); i++) { + ((StgThunk *)(p))->payload[i] = 0; + } + } + } +} + +/* -------------------------------------------------------------------------- + * 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 + * is an ordinary closure, LDV_recordDead() is called on c with its + * proper size which excludes the profiling header portion in the + * closure. Returns the size of the closure, including the profiling + * header portion, so that the caller can find the next closure. + * ----------------------------------------------------------------------- */ +STATIC_INLINE nat +processHeapClosureForDead( StgClosure *c ) +{ + nat size; + StgInfoTable *info; + + info = get_itbl(c); + + if (info->type != EVACUATED) { + 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) <= era && + (LDVW(c) & LDV_LAST_MASK) > 0 + )); + } + + if (info->type == EVACUATED) { + // The size of the evacuated closure is currently stored in + // the LDV field. See SET_EVACUAEE_FOR_LDV() in + // includes/StgLdvProf.h. + return LDVW(c); + } + + size = closure_sizeW(c); + + switch (info->type) { + /* + 'inherently used' cases: do nothing. + */ + case TSO: + case MVAR: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + case ARR_WORDS: + case WEAK: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: + case BCO: + case STABLE_NAME: + case TVAR_WAIT_QUEUE: + case TVAR: + case TREC_HEADER: + case TREC_CHUNK: + return size; + + /* + ordinary cases: call LDV_recordDead(). + */ + case THUNK: + case THUNK_1_0: + case THUNK_0_1: + case THUNK_SELECTOR: + case THUNK_2_0: + case THUNK_1_1: + case THUNK_0_2: + case AP: + case PAP: + case AP_STACK: + 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: + case SE_BLACKHOLE: + case CAF_BLACKHOLE: + case SE_CAF_BLACKHOLE: + case IND_PERM: + case IND_OLDGEN_PERM: + /* + 'Ingore' cases + */ + // Why can we ignore IND/IND_OLDGEN closures? We assume that + // any census is preceded by a major garbage collection, which + // IND/IND_OLDGEN closures cannot survive. Therefore, it is no + // use considering IND/IND_OLDGEN closures in the meanwhile + // because they will perish before the next census at any + // rate. + case IND: + case IND_OLDGEN: + // Found a dead closure: record its size + LDV_recordDead(c, size); + return size; + + /* + Error case + */ + // 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 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 processHeapClosureForDead(): %d", info->type); + return 0; + } +} + +/* -------------------------------------------------------------------------- + * Calls processHeapClosureForDead() on every *dead* closures in the + * heap blocks starting at bd. + * ----------------------------------------------------------------------- */ +static void +processHeapForDead( bdescr *bd ) +{ + StgPtr p; + + while (bd != NULL) { + p = bd->start; + while (p < bd->free) { + p += processHeapClosureForDead((StgClosure *)p); + while (p < bd->free && !*p) // skip slop + p++; + } + ASSERT(p == bd->free); + bd = bd->link; + } +} + +/* -------------------------------------------------------------------------- + * Calls processHeapClosureForDead() on every *dead* closures in the nursery. + * ----------------------------------------------------------------------- */ +static void +processNurseryForDead( void ) +{ + StgPtr p, bdLimit; + bdescr *bd; + + bd = MainCapability.r.rNursery->blocks; + while (bd->start < bd->free) { + p = bd->start; + bdLimit = bd->start + BLOCK_SIZE_W; + while (p < bd->free && p < bdLimit) { + p += processHeapClosureForDead((StgClosure *)p); + while (p < bd->free && p < bdLimit && !*p) // skip slop + p++; + } + bd = bd->link; + if (bd == NULL) + break; + } +} + +/* -------------------------------------------------------------------------- + * Calls processHeapClosureForDead() on every *dead* closures in the + * small object pool. + * ----------------------------------------------------------------------- */ +static void +processSmallObjectPoolForDead( void ) +{ + bdescr *bd; + StgPtr p; + + bd = small_alloc_list; + + // first block + if (bd == NULL) + return; + + p = bd->start; + while (p < alloc_Hp) { + p += processHeapClosureForDead((StgClosure *)p); + 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) { + p += processHeapClosureForDead((StgClosure *)p); + while (p < bd->free && !*p) // skip slop + p++; + } + ASSERT(p == bd->free); + bd = bd->link; + } +} + +/* -------------------------------------------------------------------------- + * Calls processHeapClosureForDead() on every *dead* closures in the closure + * chain. + * ----------------------------------------------------------------------- */ +static void +processChainForDead( bdescr *bd ) +{ + // Any object still in the chain is dead! + while (bd != NULL) { + processHeapClosureForDead((StgClosure *)bd->start); + bd = bd->link; + } +} + +/* -------------------------------------------------------------------------- + * Start a census for *dead* closures, and calls + * processHeapClosureForDead() on every closure which died in the + * current garbage collection. This function is called from a garbage + * collector right before tidying up, when all dead closures are still + * stored in the heap and easy to identify. Generations 0 through N + * have just beed garbage collected. + * ----------------------------------------------------------------------- */ +void +LdvCensusForDead( nat N ) +{ + nat g, s; + + // ldvTime == 0 means that LDV profiling is currently turned off. + if (era == 0) + return; + + 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 <= N; g++) + for (s = 0; s < generations[g].n_steps; s++) { + if (g == 0 && s == 0) { + processSmallObjectPoolForDead(); + processNurseryForDead(); + processChainForDead(generations[g].steps[s].large_objects); + } else{ + processHeapForDead(generations[g].steps[s].old_blocks); + processChainForDead(generations[g].steps[s].large_objects); + } + } + } +} + +/* -------------------------------------------------------------------------- + * Regard any closure in the current heap as dead or moribund and update + * LDV statistics accordingly. + * Called from shutdownHaskell() in RtsStartup.c. + * Also, stops LDV profiling by resetting ldvTime to 0. + * ----------------------------------------------------------------------- */ +void +LdvCensusKillAll( void ) +{ + LdvCensusForDead(RtsFlags.GcFlags.generations - 1); +} + +#endif /* PROFILING */ |