X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FThreadPaused.c;h=aeae1d412848b855253d693294141600e23a95e2;hp=e76d70fbd5f52b986b3e1fcf9077ebbdea4f6c37;hb=0885017a4e92fe5710d1427c214adb87b92987e5;hpb=b33fa57b919b0b315a64662b72203de68958e0a4 diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c index e76d70f..aeae1d4 100644 --- a/rts/ThreadPaused.c +++ b/rts/ThreadPaused.c @@ -6,13 +6,15 @@ * * ---------------------------------------------------------------------------*/ +// #include "PosixSource.h" #include "Rts.h" -#include "Storage.h" -#include "LdvProfile.h" + +#include "ThreadPaused.h" +#include "sm/Storage.h" #include "Updates.h" #include "RaiseAsync.h" #include "Trace.h" -#include "RtsFlags.h" +#include "Threads.h" #include // for memmove() @@ -27,7 +29,7 @@ struct stack_gap { StgWord gap_size; struct stack_gap *next_gap; }; static void -stackSqueeze(StgTSO *tso, StgPtr bottom) +stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) { StgPtr frame; rtsBool prev_was_update_frame; @@ -42,15 +44,15 @@ stackSqueeze(StgTSO *tso, StgPtr bottom) // contains two values: the size of the gap, and the distance // to the next gap (or the stack top). - frame = tso->sp; + frame = tso->stackobj->sp; ASSERT(frame < bottom); prev_was_update_frame = rtsFalse; current_gap_size = 0; - gap = (struct stack_gap *) (tso->sp - sizeofW(StgUpdateFrame)); + gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame)); - while (frame < bottom) { + while (frame <= bottom) { info = get_ret_itbl((StgClosure *)frame); switch (info->i.type) { @@ -74,7 +76,7 @@ stackSqueeze(StgTSO *tso, StgPtr bottom) * screw us up if we don't check. */ if (upd->updatee != updatee && !closure_IND(upd->updatee)) { - UPD_IND_NOLOCK(upd->updatee, updatee); + updateThunk(cap, tso, upd->updatee, updatee); } // now mark this update frame as a stack gap. The gap @@ -141,28 +143,28 @@ stackSqueeze(StgTSO *tso, StgPtr bottom) // indicates unused // { - void *sp; - void *gap_start, *next_gap_start, *gap_end; + StgWord8 *sp; + StgWord8 *gap_start, *next_gap_start, *gap_end; nat chunk_size; - next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame)); + next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame); sp = next_gap_start; - while ((StgPtr)gap > tso->sp) { + while ((StgPtr)gap > tso->stackobj->sp) { // we're working in *bytes* now... gap_start = next_gap_start; - gap_end = (void*) ((unsigned char*)gap_start - gap->gap_size * sizeof(W_)); + gap_end = gap_start - gap->gap_size * sizeof(W_); gap = gap->next_gap; - next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame)); + next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame); - chunk_size = (unsigned char*)gap_end - (unsigned char*)next_gap_start; + chunk_size = gap_end - next_gap_start; sp -= chunk_size; memmove(sp, next_gap_start, chunk_size); } - tso->sp = (StgPtr)sp; + tso->stackobj->sp = (StgPtr)sp; } } @@ -178,6 +180,8 @@ threadPaused(Capability *cap, StgTSO *tso) { StgClosure *frame; StgRetInfoTable *info; + const StgInfoTable *bh_info; + const StgInfoTable *cur_bh_info USED_IF_THREADS; StgClosure *bh; StgPtr stack_end; nat words_to_squeeze = 0; @@ -193,64 +197,97 @@ threadPaused(Capability *cap, StgTSO *tso) maybePerformBlockedException (cap, tso); if (tso->what_next == ThreadKilled) { return; } - stack_end = &tso->stack[tso->stack_size]; - - frame = (StgClosure *)tso->sp; + // NB. Blackholing is *compulsory*, we must either do lazy + // blackholing, or eager blackholing consistently. See Note + // [upd-black-hole] in sm/Scav.c. - while (1) { - // If we've already marked this frame, then stop here. - if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) { - goto end; - } + stack_end = tso->stackobj->stack + tso->stackobj->stack_size; + + frame = (StgClosure *)tso->stackobj->sp; - info = get_ret_itbl(frame); + while ((P_)frame < stack_end) { + info = get_ret_itbl(frame); switch (info->i.type) { - + case UPDATE_FRAME: + // If we've already marked this frame, then stop here. + if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) { + if (prev_was_update_frame) { + words_to_squeeze += sizeofW(StgUpdateFrame); + weight += weight_pending; + weight_pending = 0; + } + goto end; + } + SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info); bh = ((StgUpdateFrame *)frame)->updatee; + bh_info = bh->header.info; - if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) { +#ifdef THREADED_RTS + retry: +#endif + if (bh_info == &stg_BLACKHOLE_info || + bh_info == &stg_WHITEHOLE_info) + { debugTrace(DEBUG_squeeze, "suspending duplicate work: %ld words of stack", - (long)((StgPtr)frame - tso->sp)); + (long)((StgPtr)frame - tso->stackobj->sp)); // If this closure is already an indirection, then - // suspend the computation up to this point: - suspendComputation(cap,tso,(StgPtr)frame); + // suspend the computation up to this point. + // NB. check raiseAsync() to see what happens when + // we're in a loop (#2783). + suspendComputation(cap,tso,(StgUpdateFrame*)frame); // Now drop the update frame, and arrange to return // the value to the frame underneath: - tso->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2; - tso->sp[1] = (StgWord)bh; - tso->sp[0] = (W_)&stg_enter_info; + tso->stackobj->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2; + tso->stackobj->sp[1] = (StgWord)bh; + ASSERT(bh->header.info != &stg_TSO_info); + tso->stackobj->sp[0] = (W_)&stg_enter_info; // And continue with threadPaused; there might be // yet more computation to suspend. - threadPaused(cap,tso); - return; + frame = (StgClosure *)(tso->stackobj->sp + 2); + prev_was_update_frame = rtsFalse; + continue; } - if (bh->header.info != &stg_CAF_BLACKHOLE_info) { -#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) - debugBelch("Unexpected lazy BHing required at 0x%04lx\n",(long)bh); -#endif - // zero out the slop so that the sanity checker can tell - // where the next closure is. - DEBUG_FILL_SLOP(bh); -#ifdef PROFILING - // @LDV profiling - // We pretend that bh is now dead. - LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh); + + // zero out the slop so that the sanity checker can tell + // where the next closure is. + OVERWRITING_CLOSURE(bh); + + // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a + // BLACKHOLE here. +#ifdef THREADED_RTS + // first we turn it into a WHITEHOLE to claim it, and if + // successful we write our TSO and then the BLACKHOLE info pointer. + cur_bh_info = (const StgInfoTable *) + cas((StgVolatilePtr)&bh->header.info, + (StgWord)bh_info, + (StgWord)&stg_WHITEHOLE_info); + + if (cur_bh_info != bh_info) { + bh_info = cur_bh_info; + goto retry; + } #endif - SET_INFO(bh,&stg_BLACKHOLE_info); - // We pretend that bh has just been created. - LDV_RECORD_CREATE(bh); - } + // The payload of the BLACKHOLE points to the TSO + ((StgInd *)bh)->indirectee = (StgClosure *)tso; + write_barrier(); + SET_INFO(bh,&stg_BLACKHOLE_info); + + // .. and we need a write barrier, since we just mutated the closure: + recordClosureMutated(cap,bh); + + // We pretend that bh has just been created. + LDV_RECORD_CREATE(bh); frame = (StgClosure *) ((StgUpdateFrame *)frame + 1); if (prev_was_update_frame) { @@ -261,7 +298,8 @@ threadPaused(Capability *cap, StgTSO *tso) prev_was_update_frame = rtsTrue; break; - case STOP_FRAME: + case UNDERFLOW_FRAME: + case STOP_FRAME: goto end; // normal stack frames; do nothing except advance the pointer @@ -285,7 +323,13 @@ end: // the number of words we have to shift down is less than the // number of stack words we squeeze away by doing so. if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue && - weight < words_to_squeeze) { - stackSqueeze(tso, (StgPtr)frame); + ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) { + // threshold above bumped from 5 to 8 as a result of #2797 + stackSqueeze(cap, tso, (StgPtr)frame); + tso->flags |= TSO_SQUEEZED; + // This flag tells threadStackOverflow() that the stack was + // squeezed, because it may not need to be expanded. + } else { + tso->flags &= ~TSO_SQUEEZED; } }