X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=f75250659cebb9b6806c77c0a98dbaa8095ab7de;hp=e63fb54978fc2ef727fc4ee3a4fea90bbc5d57fc;hb=refs%2Ftags%2FBefore_type_family_merge;hpb=9cef40bd4dd2536c7a370a1a9b78461c152805cc diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index e63fb54..f752506 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -22,13 +22,11 @@ #include "RetainerSet.h" #include "Schedule.h" #include "Printer.h" -#include "Storage.h" #include "RtsFlags.h" #include "Weak.h" #include "Sanity.h" #include "Profiling.h" #include "Stats.h" -#include "BlockAlloc.h" #include "ProfHeap.h" #include "Apply.h" @@ -366,8 +364,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 @@ -620,9 +617,7 @@ 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: @@ -662,6 +657,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 @@ -980,9 +981,7 @@ 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: @@ -1146,9 +1145,7 @@ 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: @@ -1383,7 +1380,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 +1404,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 +1439,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 +1485,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 +1495,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 +1544,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 +1584,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 @@ -1798,16 +1798,19 @@ inner_loop: static void retainRoot( 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))); @@ -2114,8 +2117,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 +2126,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));