X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FThreadPaused.c;h=58c30e330e1a147abe5066c0a1a049a1aa9f7f30;hb=6cf8982ac30be6836a0cdd8be5a6ac1a1a144213;hp=c32a75b9a8e9fd5c1979e31677c0133ad9756293;hpb=804a84fbc46cd07146ed7689bb8fa3e94eeb756a;p=ghc-hetmet.git diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c index c32a75b..58c30e3 100644 --- a/rts/ThreadPaused.c +++ b/rts/ThreadPaused.c @@ -6,13 +6,14 @@ * * ---------------------------------------------------------------------------*/ +// #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 // for memmove() @@ -74,7 +75,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); + UPD_IND(upd->updatee, updatee); } // now mark this update frame as a stack gap. The gap @@ -141,23 +142,23 @@ 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) { // 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); } @@ -195,6 +196,10 @@ threadPaused(Capability *cap, StgTSO *tso) maybePerformBlockedException (cap, tso); if (tso->what_next == ThreadKilled) { return; } + // NB. Blackholing is *not* optional, we must either do lazy + // blackholing, or eager blackholing consistently. See Note + // [upd-black-hole] in sm/Scav.c. + stack_end = &tso->stack[tso->stack_size]; frame = (StgClosure *)tso->sp; @@ -231,8 +236,10 @@ threadPaused(Capability *cap, StgTSO *tso) (long)((StgPtr)frame - tso->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: @@ -242,14 +249,12 @@ threadPaused(Capability *cap, StgTSO *tso) // And continue with threadPaused; there might be // yet more computation to suspend. - threadPaused(cap,tso); - return; + frame = (StgClosure *)tso->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); @@ -258,7 +263,7 @@ threadPaused(Capability *cap, StgTSO *tso) // We pretend that bh is now dead. LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh); #endif - + // an EAGER_BLACKHOLE gets turned into a BLACKHOLE here. #ifdef THREADED_RTS cur_bh_info = (const StgInfoTable *) cas((StgVolatilePtr)&bh->header.info,