X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FLdvProfile.c;h=7bc032e05d23898e7df2a690cb6d1021beb722dc;hp=28aa326ede2bbf5676059d2d8b7e53f39e8a2fbd;hb=26f4bfc82f2b2359259578e9c54d476fc2de650f;hpb=1cb0eb071f1316d6650f354166506789a2638720 diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c index 28aa326..7bc032e 100644 --- a/rts/LdvProfile.c +++ b/rts/LdvProfile.c @@ -9,53 +9,16 @@ #ifdef PROFILING +#include "PosixSource.h" #include "Rts.h" -#include "LdvProfile.h" -#include "RtsFlags.h" + #include "Profiling.h" +#include "LdvProfile.h" #include "Stats.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 @@ -68,26 +31,27 @@ STATIC_INLINE nat processHeapClosureForDead( StgClosure *c ) { nat size; - StgInfoTable *info; + const 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) { + info = c->header.info; + if (IS_FORWARDING_PTR(info)) { // 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); } + info = INFO_PTR_TO_STRUCT(info); + + 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 + )); + size = closure_sizeW(c); @@ -96,7 +60,9 @@ processHeapClosureForDead( StgClosure *c ) 'inherently used' cases: do nothing. */ case TSO: - case MVAR: + case STACK: + case MVAR_CLEAN: + case MVAR_DIRTY: case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: @@ -106,13 +72,9 @@ processHeapClosureForDead( StgClosure *c ) case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case BCO: - case STABLE_NAME: - case TVAR_WATCH_QUEUE: - case TVAR: - case TREC_HEADER: + case PRIM: + case MUT_PRIM: case TREC_CHUNK: - case INVARIANT_CHECK_QUEUE: - case ATOMIC_INVARIANT: return size; /* @@ -141,22 +103,18 @@ processHeapClosureForDead( StgClosure *c ) case FUN_1_1: case FUN_0_2: case BLACKHOLE: - case SE_BLACKHOLE: - case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: + case BLOCKING_QUEUE: case IND_PERM: - case IND_OLDGEN_PERM: /* 'Ingore' cases */ - // Why can we ignore IND/IND_OLDGEN closures? We assume that + // Why can we ignore IND 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 + // IND closures cannot survive. Therefore, it is no + // use considering IND 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; @@ -173,19 +131,13 @@ processHeapClosureForDead( StgClosure *c ) // stack objects case UPDATE_FRAME: case CATCH_FRAME: + case UNDERFLOW_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); @@ -239,43 +191,6 @@ processNurseryForDead( void ) } /* -------------------------------------------------------------------------- - * 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. * ----------------------------------------------------------------------- */ @@ -284,7 +199,9 @@ processChainForDead( bdescr *bd ) { // Any object still in the chain is dead! while (bd != NULL) { - processHeapClosureForDead((StgClosure *)bd->start); + if (!(bd->flags & BF_PINNED)) { + processHeapClosureForDead((StgClosure *)bd->start); + } bd = bd->link; } } @@ -300,7 +217,7 @@ processChainForDead( bdescr *bd ) void LdvCensusForDead( nat N ) { - nat g, s; + nat g; // ldvTime == 0 means that LDV profiling is currently turned off. if (era == 0) @@ -312,17 +229,11 @@ LdvCensusForDead( nat N ) // 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); - } - } + processNurseryForDead(); + for (g = 0; g <= N; g++) { + processHeapForDead(generations[g].old_blocks); + processChainForDead(generations[g].large_objects); + } } }