X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=4bfda6fef8eb5ceb0833c5c73483f3b169944c2c;hp=745b8e75dba0f4dd8f48f4fa14e3f7ca6795dfad;hb=0885017a4e92fe5710d1427c214adb87b92987e5;hpb=1ed01a871030f05905a9595e4837dfffc087ef64 diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 745b8e7..4bfda6f 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -16,19 +16,21 @@ #define INLINE inline #endif +#include "PosixSource.h" #include "Rts.h" + #include "RtsUtils.h" #include "RetainerProfile.h" #include "RetainerSet.h" #include "Schedule.h" #include "Printer.h" -#include "RtsFlags.h" #include "Weak.h" -#include "Sanity.h" +#include "sm/Sanity.h" #include "Profiling.h" #include "Stats.h" #include "ProfHeap.h" #include "Apply.h" +#include "sm/Storage.h" // for END_OF_STATIC_LIST /* Note: what to change in order to plug-in a new retainer profiling scheme? @@ -364,7 +366,7 @@ find_srt( stackPos *info ) bitmap = info->next.srt.srt_bitmap; while (bitmap != 0) { if ((bitmap & 1) != 0) { -#if defined(__PIC__) && defined(mingw32_TARGET_OS) +#if defined(__PIC__) && defined(mingw32_HOST_OS) if ((unsigned long)(*(info->next.srt.srt)) & 0x1) c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1); else @@ -451,10 +453,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // no child, no SRT case CONSTR_0_1: case CONSTR_0_2: - case CAF_BLACKHOLE: - case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: case ARR_WORDS: *first_child = NULL; return; @@ -468,8 +466,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) *first_child = ((StgSelector *)c)->selectee; return; case IND_PERM: - case IND_OLDGEN_PERM: - case IND_OLDGEN: + case BLACKHOLE: *first_child = ((StgInd *)c)->indirectee; return; case CONSTR_1_0: @@ -509,7 +506,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // layout.payload.ptrs, no SRT case CONSTR: - case STABLE_NAME: + case PRIM: + case MUT_PRIM: case BCO: case CONSTR_STATIC: init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, @@ -589,16 +587,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) return; // no child break; - case TVAR_WATCH_QUEUE: - *first_child = (StgClosure *)((StgTVarWatchQueue *)c)->closure; - se.info.next.step = 2; // 2 = second - break; - case TVAR: - *first_child = (StgClosure *)((StgTVar *)c)->current_value; - break; - case TREC_HEADER: - *first_child = (StgClosure *)((StgTRecHeader *)c)->enclosing_trec; - break; case TREC_CHUNK: *first_child = (StgClosure *)((StgTRecChunk *)c)->prev_chunk; se.info.next.step = 0; // entry no. @@ -609,11 +597,13 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) case AP: case AP_STACK: case TSO: + case STACK: case IND_STATIC: case CONSTR_NOCAF_STATIC: // stack objects case UPDATE_FRAME: case CATCH_FRAME: + case UNDERFLOW_FRAME: case STOP_FRAME: case RET_DYN: case RET_BCO: @@ -621,12 +611,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) case RET_BIG: // invalid objects 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 *c in push()"); @@ -833,33 +817,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) *r = se->c_child_r; return; - case TVAR_WATCH_QUEUE: - if (se->info.next.step == 2) { - *c = (StgClosure *)((StgTVarWatchQueue *)se->c)->next_queue_entry; - se->info.next.step++; // move to the next step - // no popOff - } else { - *c = (StgClosure *)((StgTVarWatchQueue *)se->c)->prev_queue_entry; - popOff(); - } - *cp = se->c; - *r = se->c_child_r; - return; - - case TVAR: - *c = (StgClosure *)((StgTVar *)se->c)->first_watch_queue_entry; - *cp = se->c; - *r = se->c_child_r; - popOff(); - return; - - case TREC_HEADER: - *c = (StgClosure *)((StgTRecHeader *)se->c)->current_chunk; - *cp = se->c; - *r = se->c_child_r; - popOff(); - return; - case TREC_CHUNK: { // These are pretty complicated: we have N entries, each // of which contains 3 fields that we want to follow. So @@ -889,7 +846,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) } case CONSTR: - case STABLE_NAME: + case PRIM: + case MUT_PRIM: case BCO: case CONSTR_STATIC: // StgMutArrPtr.ptrs, no SRT @@ -957,42 +915,32 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) // no child (fixed), no SRT case CONSTR_0_1: case CONSTR_0_2: - case CAF_BLACKHOLE: - case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: case ARR_WORDS: // one child (fixed), no SRT case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case THUNK_SELECTOR: case IND_PERM: - case IND_OLDGEN_PERM: - case IND_OLDGEN: case CONSTR_1_1: // cannot appear case PAP: case AP: case AP_STACK: case TSO: - case IND_STATIC: + case STACK: + case IND_STATIC: case CONSTR_NOCAF_STATIC: // stack objects case RET_DYN: case UPDATE_FRAME: case CATCH_FRAME: - case STOP_FRAME: + case UNDERFLOW_FRAME: + case STOP_FRAME: case RET_BCO: case RET_SMALL: case RET_BIG: // invalid objects 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 *c in pop()"); @@ -1057,8 +1005,10 @@ isRetainer( StgClosure *c ) // // TSOs MUST be retainers: they constitute the set of roots. case TSO: + case STACK: // mutable objects + case MUT_PRIM: case MVAR_CLEAN: case MVAR_DIRTY: case MUT_VAR_CLEAN: @@ -1085,10 +1035,6 @@ isRetainer( StgClosure *c ) // WEAK objects are roots; there is separate code in which traversing // begins from WEAK objects. case WEAK: - - // Since the other mutvar-type things are retainers, seems - // like the right thing to do: - case TVAR: return rtsTrue; // @@ -1111,33 +1057,27 @@ isRetainer( StgClosure *c ) case FUN_0_2: // partial applications case PAP: - // blackholes - case CAF_BLACKHOLE: - case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: // indirection case IND_PERM: - case IND_OLDGEN_PERM: - case IND_OLDGEN: + // IND_STATIC used to be an error, but at the moment it can happen + // as isAlive doesn't look through IND_STATIC as it ignores static + // closures. See trac #3956 for a program that hit this error. + case IND_STATIC: + case BLACKHOLE: // static objects case CONSTR_STATIC: case FUN_STATIC: // misc - case STABLE_NAME: + case PRIM: case BCO: case ARR_WORDS: // STM - case TVAR_WATCH_QUEUE: - case TREC_HEADER: case TREC_CHUNK: return rtsFalse; // // Error case // - // IND_STATIC cannot be *c, *cp, *r in the retainer profiling loop. - case IND_STATIC: // CONSTR_NOCAF_STATIC // cannot be *c, *cp, *r in the retainer profiling loop. case CONSTR_NOCAF_STATIC: @@ -1145,6 +1085,7 @@ isRetainer( StgClosure *c ) // legal objects during retainer profiling. case UPDATE_FRAME: case CATCH_FRAME: + case UNDERFLOW_FRAME: case STOP_FRAME: case RET_DYN: case RET_BCO: @@ -1152,12 +1093,6 @@ isRetainer( StgClosure *c ) case RET_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 isRetainer(): %d", get_itbl(c)->type); @@ -1300,9 +1235,9 @@ retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r) while (bitmap != 0) { if ((bitmap & 1) != 0) { -#ifdef ENABLE_WIN32_DLL_SUPPORT +#if defined(__PIC__) && defined(mingw32_HOST_OS) if ( (unsigned long)(*srt) & 0x1 ) { - retainClosure(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)), + retainClosure(* (StgClosure**) ((unsigned long) (*srt) & ~0x1), c, c_child_r); } else { retainClosure(*srt,c,c_child_r); @@ -1328,8 +1263,8 @@ retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r) * RSET(c) and RSET(c_child_r) are valid, i.e., their * interpretation conforms to the current value of flip (even when they * are interpreted to be NULL). - * If *c is TSO, its state is not any of ThreadRelocated, ThreadComplete, - * or ThreadKilled, which means that its stack is ready to process. + * If *c is TSO, its state is not ThreadComplete,or ThreadKilled, + * which means that its stack is ready to process. * Note: * This code was almost plagiarzied from GC.c! For each pointer, * retainClosure() is invoked instead of evacuate(). @@ -1341,7 +1276,7 @@ retainStack( StgClosure *c, retainer c_child_r, stackElement *oldStackBoundary; StgPtr p; StgRetInfoTable *info; - StgWord32 bitmap; + StgWord bitmap; nat size; #ifdef DEBUG_RETAINER @@ -1362,11 +1297,8 @@ retainStack( StgClosure *c, retainer c_child_r, // debugBelch("retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary); #endif - ASSERT(get_itbl(c)->type != TSO || - (((StgTSO *)c)->what_next != ThreadRelocated && - ((StgTSO *)c)->what_next != ThreadComplete && - ((StgTSO *)c)->what_next != ThreadKilled)); - + ASSERT(get_itbl(c)->type == STACK); + p = stackStart; while (p < stackEnd) { info = get_ret_itbl((StgClosure *)p); @@ -1378,7 +1310,8 @@ retainStack( StgClosure *c, retainer c_child_r, p += sizeofW(StgUpdateFrame); continue; - case STOP_FRAME: + case UNDERFLOW_FRAME: + case STOP_FRAME: case CATCH_FRAME: case CATCH_STM_FRAME: case CATCH_RETRY_FRAME: @@ -1631,14 +1564,7 @@ inner_loop: #endif goto loop; } - if (((StgTSO *)c)->what_next == ThreadRelocated) { -#ifdef DEBUG_RETAINER - debugBelch("ThreadRelocated encountered in retainClosure()\n"); -#endif - c = (StgClosure *)((StgTSO *)c)->link; - goto inner_loop; - } - break; + break; case IND_STATIC: // We just skip IND_STATIC, so its retainer set is never computed. @@ -1752,12 +1678,29 @@ inner_loop: // than attempting to save the current position, because doing so // would be hard. switch (typeOfc) { - case TSO: + case STACK: retainStack(c, c_child_r, - ((StgTSO *)c)->sp, - ((StgTSO *)c)->stack + ((StgTSO *)c)->stack_size); + ((StgStack *)c)->sp, + ((StgStack *)c)->stack + ((StgStack *)c)->stack_size); goto loop; + case TSO: + { + StgTSO *tso = (StgTSO *)c; + + retainClosure(tso->stackobj, c, c_child_r); + retainClosure(tso->blocked_exceptions, c, c_child_r); + retainClosure(tso->bq, c, c_child_r); + retainClosure(tso->trec, c, c_child_r); + if ( tso->why_blocked == BlockedOnMVar + || tso->why_blocked == BlockedOnBlackHole + || tso->why_blocked == BlockedOnMsgThrowTo + ) { + retainClosure(tso->block_info.closure, c, c_child_r); + } + goto loop; + } + case PAP: { StgPAP *pap = (StgPAP *)c; @@ -1800,7 +1743,7 @@ inner_loop: * Compute the retainer set for every object reachable from *tl. * -------------------------------------------------------------------------- */ static void -retainRoot( StgClosure **tl ) +retainRoot(void *user STG_UNUSED, StgClosure **tl) { StgClosure *c; @@ -1830,14 +1773,14 @@ computeRetainerSet( void ) { StgWeak *weak; RetainerSet *rtl; - nat g; + nat g, n; StgPtr ml; bdescr *bd; #ifdef DEBUG_RETAINER RetainerSet tmpRetainerSet; #endif - GetRoots(retainRoot); // for scheduler roots + markCapabilities(retainRoot, NULL); // for scheduler roots // This function is called after a major GC, when key, value, and finalizer // all are guaranteed to be valid, or reachable. @@ -1846,10 +1789,10 @@ computeRetainerSet( void ) // for retainer profilng. for (weak = weak_ptr_list; weak != NULL; weak = weak->link) // retainRoot((StgClosure *)weak); - retainRoot((StgClosure **)&weak); + retainRoot(NULL, (StgClosure **)&weak); // Consider roots from the stable ptr table. - markStablePtrTable(retainRoot); + markStablePtrTable(retainRoot, NULL); // The following code resets the rs field of each unvisited mutable // object (computing sumOfNewCostExtra and updating costArray[] when @@ -1861,7 +1804,8 @@ computeRetainerSet( void ) // Traversing through mut_list is necessary // because we can find MUT_VAR objects which have not been // visited during retainer profiling. - for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { + for (n = 0; n < n_capabilities; n++) { + for (bd = capabilities[n].mut_lists[g]; bd != NULL; bd = bd->link) { for (ml = bd->start; ml < bd->free; ml++) { maybeInitRetainerSet((StgClosure *)*ml); @@ -1892,7 +1836,8 @@ computeRetainerSet( void ) } #endif } - } + } + } } } @@ -1913,7 +1858,7 @@ computeRetainerSet( void ) * they are not taken into consideration in computing retainer sets. * -------------------------------------------------------------------------- */ void -resetStaticObjectForRetainerProfiling( void ) +resetStaticObjectForRetainerProfiling( StgClosure *static_objects ) { #ifdef DEBUG_RETAINER nat count; @@ -1923,7 +1868,7 @@ resetStaticObjectForRetainerProfiling( void ) #ifdef DEBUG_RETAINER count = 0; #endif - p = scavenged_static_objects; + p = static_objects; while (p != END_OF_STATIC_LIST) { #ifdef DEBUG_RETAINER count++; @@ -2170,7 +2115,7 @@ smallObjectPoolCheck(void) StgPtr p; static nat costSum, size; - bd = small_alloc_list; + bd = g0s0->blocks; costSum = 0; // first block