X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=e96356734dbb8a8046c61a0d98d7b1a6b6c0ec7b;hp=c5c3de53145779684aefcc7f6de0ccc590019fdd;hb=842e9d6628a27cf1f420d53f6a5901935dc50c54;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index c5c3de5..e963567 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 @@ -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,9 +618,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: @@ -664,6 +658,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 +805,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 +833,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 +847,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 +866,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 +874,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) { @@ -974,8 +976,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,9 +984,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: @@ -1061,7 +1059,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: @@ -1129,7 +1128,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 +1138,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,9 +1149,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: @@ -1389,7 +1384,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 +1408,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 +1443,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 +1489,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 +1499,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 +1548,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 +1588,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 +1607,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: @@ -1648,8 +1644,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 @@ -1808,16 +1802,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))); @@ -1880,8 +1877,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: @@ -2012,8 +2007,6 @@ retainerProfile(void) pcostArrayLinear(FUN_STATIC); pcostArrayLinear(CONSTR_STATIC); pcostArrayLinear(CONSTR_NOCAF_STATIC); - pcostArrayLinear(CONSTR_INTLIKE); - pcostArrayLinear(CONSTR_CHARLIKE); */ #endif @@ -2128,8 +2121,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 +2130,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 +2170,7 @@ smallObjectPoolCheck(void) StgPtr p; static nat costSum, size; - bd = small_alloc_list; + bd = g0s0->blocks; costSum = 0; // first block