X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=fdddd8da5db613b8b22edb7aa44831c8e33a10cf;hb=25dc791642decde99a9846145c43150cb34527b0;hp=cd0001311d294596f5a1d6e148e569b58d9de802;hpb=ab0e778ccfde61aed4c22679b24d175fc6cc9bf3;p=ghc-hetmet.git diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index cd00013..fdddd8d 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -16,21 +16,21 @@ #define INLINE inline #endif +#include "PosixSource.h" #include "Rts.h" + #include "RtsUtils.h" #include "RetainerProfile.h" #include "RetainerSet.h" -#include "Storage.h" #include "Schedule.h" -#include "Stable.h" #include "Printer.h" -#include "RtsFlags.h" #include "Weak.h" #include "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? @@ -366,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_TARGET_OS) if ((unsigned long)(*(info->next.srt.srt)) & 0x1) c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1); else @@ -456,8 +455,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) case CONSTR_0_2: case CAF_BLACKHOLE: case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: case ARR_WORDS: *first_child = NULL; return; @@ -494,7 +491,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; @@ -620,17 +618,9 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) case RET_DYN: case RET_BCO: case RET_SMALL: - case RET_VEC_SMALL: case RET_BIG: - case RET_VEC_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()"); @@ -662,6 +652,12 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // following statement by either a memcpy() call or a switch statement // on the type of the element. Currently, the size of stackElement is // small enough (5 words) that this direct assignment seems to be enough. + + // ToDo: The line below leads to the warning: + // warning: 'se.info.type' may be used uninitialized in this function + // This is caused by the fact that there are execution paths through the + // large switch statement above where some cases do not initialize this + // field. Is this really harmless? Can we avoid the warning? *stackTop = se; #ifdef DEBUG_RETAINER @@ -803,7 +799,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 @@ -863,6 +860,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) // 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) { @@ -870,7 +868,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) { @@ -955,8 +953,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) 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: @@ -980,17 +976,9 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case STOP_FRAME: case RET_BCO: case RET_SMALL: - case RET_VEC_SMALL: case RET_BIG: - case RET_VEC_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,7 +1045,8 @@ isRetainer( StgClosure *c ) case TSO: // mutable objects - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case MUT_ARR_PTRS_CLEAN: @@ -1111,8 +1100,6 @@ isRetainer( StgClosure *c ) // blackholes case CAF_BLACKHOLE: case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: // indirection case IND_PERM: case IND_OLDGEN_PERM: @@ -1146,17 +1133,9 @@ isRetainer( StgClosure *c ) 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 isRetainer(): %d", get_itbl(c)->type); @@ -1299,9 +1278,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_TARGET_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); @@ -1383,7 +1362,6 @@ retainStack( StgClosure *c, retainer c_child_r, case CATCH_RETRY_FRAME: case ATOMICALLY_FRAME: case RET_SMALL: - case RET_VEC_SMALL: bitmap = BITMAP_BITS(info->i.layout.bitmap); size = BITMAP_SIZE(info->i.layout.bitmap); p++; @@ -1408,7 +1386,6 @@ retainStack( StgClosure *c, retainer c_child_r, // large bitmap (> 32 entries, or > 64 on a 64-bit machine) case RET_BIG: - case RET_VEC_BIG: size = GET_LARGE_BITMAP(&info->i)->size; p++; retain_large_bitmap(p, GET_LARGE_BITMAP(&info->i), @@ -1444,7 +1421,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) { @@ -1490,7 +1467,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; @@ -1498,6 +1477,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); @@ -1546,9 +1526,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; @@ -1586,6 +1566,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 @@ -1631,7 +1613,7 @@ inner_loop: #ifdef DEBUG_RETAINER debugBelch("ThreadRelocated encountered in retainClosure()\n"); #endif - c = (StgClosure *)((StgTSO *)c)->link; + c = (StgClosure *)((StgTSO *)c)->_link; goto inner_loop; } break; @@ -1796,18 +1778,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))); @@ -1830,7 +1815,7 @@ computeRetainerSet( void ) 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. @@ -1839,10 +1824,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 @@ -1906,7 +1891,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; @@ -1916,7 +1901,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++; @@ -2114,8 +2099,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); @@ -2123,7 +2108,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)); @@ -2163,7 +2148,7 @@ smallObjectPoolCheck(void) StgPtr p; static nat costSum, size; - bd = small_alloc_list; + bd = g0s0->blocks; costSum = 0; // first block