X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=fdddd8da5db613b8b22edb7aa44831c8e33a10cf;hb=25dc791642decde99a9846145c43150cb34527b0;hp=c5c3de53145779684aefcc7f6de0ccc590019fdd;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index c5c3de5..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 "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" +#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; @@ -591,8 +589,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) return; // no child break; - case TVAR_WAIT_QUEUE: - *first_child = (StgClosure *)((StgTVarWaitQueue *)c)->waiting_tso; + case TVAR_WATCH_QUEUE: + *first_child = (StgClosure *)((StgTVarWatchQueue *)c)->closure; se.info.next.step = 2; // 2 = second break; case TVAR: @@ -612,8 +610,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) case AP_STACK: case TSO: case IND_STATIC: - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: case CONSTR_NOCAF_STATIC: // stack objects case UPDATE_FRAME: @@ -622,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()"); @@ -664,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 @@ -805,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 @@ -832,13 +827,13 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) *r = se->c_child_r; return; - case TVAR_WAIT_QUEUE: + case TVAR_WATCH_QUEUE: if (se->info.next.step == 2) { - *c = (StgClosure *)((StgTVarWaitQueue *)se->c)->next_queue_entry; + *c = (StgClosure *)((StgTVarWatchQueue *)se->c)->next_queue_entry; se->info.next.step++; // move to the next step // no popOff } else { - *c = (StgClosure *)((StgTVarWaitQueue *)se->c)->prev_queue_entry; + *c = (StgClosure *)((StgTVarWatchQueue *)se->c)->prev_queue_entry; popOff(); } *cp = se->c; @@ -846,7 +841,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) return; case TVAR: - *c = (StgClosure *)((StgTVar *)se->c)->first_wait_queue_entry; + *c = (StgClosure *)((StgTVar *)se->c)->first_watch_queue_entry; *cp = se->c; *r = se->c_child_r; popOff(); @@ -865,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) { @@ -872,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) { @@ -957,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: @@ -974,8 +968,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case AP_STACK: case TSO: case IND_STATIC: - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: case CONSTR_NOCAF_STATIC: // stack objects case RET_DYN: @@ -984,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()"); @@ -1061,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: @@ -1115,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: @@ -1129,7 +1112,7 @@ isRetainer( StgClosure *c ) case BCO: case ARR_WORDS: // STM - case TVAR_WAIT_QUEUE: + case TVAR_WATCH_QUEUE: case TREC_HEADER: case TREC_CHUNK: return rtsFalse; @@ -1139,10 +1122,8 @@ isRetainer( StgClosure *c ) // // IND_STATIC cannot be *c, *cp, *r in the retainer profiling loop. case IND_STATIC: - // CONSTR_INTLIKE, CONSTR_CHARLIKE, and CONSTR_NOCAF_STATIC + // CONSTR_NOCAF_STATIC // cannot be *c, *cp, *r in the retainer profiling loop. - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: case CONSTR_NOCAF_STATIC: // Stack objects are invalid because they are never treated as // legal objects during retainer profiling. @@ -1152,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); @@ -1305,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); @@ -1389,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++; @@ -1414,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), @@ -1450,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) { @@ -1496,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; @@ -1504,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); @@ -1552,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; @@ -1592,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 @@ -1609,8 +1585,6 @@ inner_loop: #ifdef DEBUG_RETAINER switch (typeOfc) { case IND_STATIC: - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: case CONSTR_NOCAF_STATIC: case CONSTR_STATIC: case THUNK_STATIC: @@ -1639,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; @@ -1648,8 +1622,6 @@ inner_loop: // We just skip IND_STATIC, so its retainer set is never computed. c = ((StgIndStatic *)c)->indirectee; goto inner_loop; - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: // static objects with no pointers out, so goto loop. case CONSTR_NOCAF_STATIC: // It is not just enough not to compute the retainer set for *c; it is @@ -1806,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))); @@ -1840,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. @@ -1849,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 @@ -1880,8 +1855,6 @@ computeRetainerSet( void ) case IND_STATIC: // no cost involved break; - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: case CONSTR_NOCAF_STATIC: case CONSTR_STATIC: case THUNK_STATIC: @@ -1918,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; @@ -1928,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++; @@ -2012,8 +1985,6 @@ retainerProfile(void) pcostArrayLinear(FUN_STATIC); pcostArrayLinear(CONSTR_STATIC); pcostArrayLinear(CONSTR_NOCAF_STATIC); - pcostArrayLinear(CONSTR_INTLIKE); - pcostArrayLinear(CONSTR_CHARLIKE); */ #endif @@ -2128,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); @@ -2137,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)); @@ -2177,7 +2148,7 @@ smallObjectPoolCheck(void) StgPtr p; static nat costSum, size; - bd = small_alloc_list; + bd = g0s0->blocks; costSum = 0; // first block