X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=4bfda6fef8eb5ceb0833c5c73483f3b169944c2c;hp=4920e7d09d205e8818502ff2f051872074537054;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=9ff76535edb25ab7434284adddb5c64708ecb547 diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 4920e7d..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,8 +366,7 @@ find_srt( stackPos *info ) bitmap = info->next.srt.srt_bitmap; while (bitmap != 0) { if ((bitmap & 1) != 0) { -#ifdef ENABLE_WIN32_DLL_SUPPORT - +#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 @@ -452,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; @@ -469,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: @@ -492,7 +488,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // three children (fixed), no SRT // need to push a stackElement - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: // head must be TSO and the head of a linked list of TSOs. // Shoule it be a child? Seems to be yes. *first_child = (StgClosure *)((StgMVar *)c)->head; @@ -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()"); @@ -805,7 +789,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) // three children (fixed), no SRT // need to push a stackElement - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: if (se->info.next.step == 2) { *c = (StgClosure *)((StgMVar *)se->c)->tail; se->info.next.step++; // move to the next step @@ -832,39 +817,13 @@ 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 // we divide the step counter: the 2 low bits indicate // which field, and the rest of the bits indicate the // entry number (starting from zero). + TRecEntry *entry; nat entry_no = se->info.next.step >> 2; nat field_no = se->info.next.step & 3; if (entry_no == ((StgTRecChunk *)se->c)->next_entry_idx) { @@ -872,7 +831,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) popOff(); return; } - TRecEntry *entry = &((StgTRecChunk *)se->c)->entries[entry_no]; + entry = &((StgTRecChunk *)se->c)->entries[entry_no]; if (field_no == 0) { *c = (StgClosure *)entry->tvar; } else if (field_no == 1) { @@ -887,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 @@ -955,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()"); @@ -1055,9 +1005,12 @@ isRetainer( StgClosure *c ) // // TSOs MUST be retainers: they constitute the set of roots. case TSO: + case STACK: // mutable objects - case MVAR: + case MUT_PRIM: + case MVAR_CLEAN: + case MVAR_DIRTY: case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case MUT_ARR_PTRS_CLEAN: @@ -1082,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; // @@ -1108,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: @@ -1142,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: @@ -1149,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); @@ -1297,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); @@ -1325,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(). @@ -1338,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 @@ -1359,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); @@ -1375,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: @@ -1440,7 +1376,7 @@ retainStack( StgClosure *c, retainer c_child_r, StgFunInfoTable *fun_info; retainClosure(ret_fun->fun, c, c_child_r); - fun_info = get_fun_itbl(ret_fun->fun); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); p = (P_)&ret_fun->payload; switch (fun_info->f.fun_type) { @@ -1486,7 +1422,9 @@ retainStack( StgClosure *c, retainer c_child_r, * ------------------------------------------------------------------------- */ static INLINE StgPtr -retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun, +retain_PAP_payload (StgClosure *pap, /* NOT tagged */ + retainer c_child_r, /* NOT tagged */ + StgClosure *fun, /* tagged */ StgClosure** payload, StgWord n_args) { StgPtr p; @@ -1494,6 +1432,7 @@ retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun, StgFunInfoTable *fun_info; retainClosure(fun, pap, c_child_r); + fun = UNTAG_CLOSURE(fun); fun_info = get_fun_itbl(fun); ASSERT(fun_info->i.type != PAP); @@ -1542,9 +1481,9 @@ retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun, static void retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 ) { - // c = Current closure - // cp = Current closure's Parent - // r = current closures' most recent Retainer + // c = Current closure (possibly tagged) + // cp = Current closure's Parent (NOT tagged) + // r = current closures' most recent Retainer (NOT tagged) // c_child_r = current closure's children's most recent retainer // first_child = first child of c StgClosure *c, *cp, *first_child; @@ -1582,6 +1521,8 @@ loop: //debugBelch("inner_loop"); inner_loop: + c = UNTAG_CLOSURE(c); + // c = current closure under consideration, // cp = current closure's parent, // r = current closure's most recent retainer @@ -1623,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. @@ -1744,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; @@ -1792,18 +1743,21 @@ 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; + // We no longer assume that only TSOs and WEAKs are roots; any closure can // be a root. ASSERT(isEmptyRetainerStack()); currentStackBoundary = stackTop; - if (*tl != &stg_END_TSO_QUEUE_closure && isRetainer(*tl)) { - retainClosure(*tl, *tl, getRetainerFrom(*tl)); + c = UNTAG_CLOSURE(*tl); + if (c != &stg_END_TSO_QUEUE_closure && isRetainer(c)) { + retainClosure(c, c, getRetainerFrom(c)); } else { - retainClosure(*tl, *tl, CCS_SYSTEM); + retainClosure(c, c, CCS_SYSTEM); } // NOT TRUE: ASSERT(isMember(getRetainerFrom(*tl), retainerSetOf(*tl))); @@ -1819,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. @@ -1835,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 @@ -1850,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); @@ -1881,7 +1836,8 @@ computeRetainerSet( void ) } #endif } - } + } + } } } @@ -1902,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; @@ -1912,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++; @@ -2110,8 +2066,8 @@ sanityCheckHeapClosure( StgClosure *c ) if ((((StgWord)RSET(c) & 1) ^ flip) != 0) { if (get_itbl(c)->type == CONSTR && - !strcmp(get_itbl(c)->prof.closure_type, "DEAD_WEAK") && - !strcmp(get_itbl(c)->prof.closure_desc, "DEAD_WEAK")) { + !strcmp(GET_PROF_TYPE(get_itbl(c)), "DEAD_WEAK") && + !strcmp(GET_PROF_DESC(get_itbl(c)), "DEAD_WEAK")) { debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c); costArray[get_itbl(c)->type] += cost(c); sumOfNewCost += cost(c); @@ -2119,7 +2075,7 @@ sanityCheckHeapClosure( StgClosure *c ) debugBelch( "Unvisited object: flip = %d, c = %p(%d, %s, %s), rs = %p\n", flip, c, get_itbl(c)->type, - get_itbl(c)->prof.closure_type, get_itbl(c)->prof.closure_desc, + get_itbl(c)->prof.closure_type, GET_PROF_DESC(get_itbl(c)), RSET(c)); } else { // debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c)); @@ -2159,7 +2115,7 @@ smallObjectPoolCheck(void) StgPtr p; static nat costSum, size; - bd = small_alloc_list; + bd = g0s0->blocks; costSum = 0; // first block