X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=9d03d07ab4be23cb9e7fc4b5e5eb5a1081f5adbe;hb=dbc1ed7e054a1c67cd34ff4776feea0d176e3bbb;hp=9041c06cb278c0513d02e291171168a95f4fbcd9;hpb=b1953bbb1ed3cb16497e5447db7487f0c2d9e41a;p=ghc-hetmet.git diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index 9041c06..9d03d07 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -13,10 +13,14 @@ #include "RaiseAsync.h" #include "SMP.h" #include "Schedule.h" -#include "Storage.h" +#include "LdvProfile.h" #include "Updates.h" #include "STM.h" #include "Sanity.h" +#include "Profiling.h" +#if defined(mingw32_HOST_OS) +#include "win32/IOManager.h" +#endif static void raiseAsync (Capability *cap, StgTSO *tso, @@ -26,7 +30,7 @@ static void raiseAsync (Capability *cap, static void removeFromQueues(Capability *cap, StgTSO *tso); -static void blockedThrowTo (StgTSO *source, StgTSO *target); +static void blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target); static void performBlockedException (Capability *cap, StgTSO *source, StgTSO *target); @@ -148,13 +152,13 @@ throwTo (Capability *cap, // the Capability we hold // follow ThreadRelocated links in the target first while (target->what_next == ThreadRelocated) { - target = target->link; + target = target->_link; // No, it might be a WHITEHOLE: // ASSERT(get_itbl(target)->type == TSO); } - debugTrace(DEBUG_sched, "throwTo: from thread %d to thread %d", - source->id, target->id); + debugTrace(DEBUG_sched, "throwTo: from thread %lu to thread %lu", + (unsigned long)source->id, (unsigned long)target->id); #ifdef DEBUG if (traceClass(DEBUG_sched)) { @@ -240,7 +244,7 @@ check_target: { Capability *target_cap; - wb(); + write_barrier(); target_cap = target->cap; if (target_cap == cap && (target->flags & TSO_BLOCKEX) == 0) { // It's on our run queue and not blocking exceptions @@ -257,10 +261,10 @@ check_target: // just moved this TSO. if (target->what_next == ThreadRelocated) { unlockTSO(target); - target = target->link; + target = target->_link; goto retry; } - blockedThrowTo(source,target); + blockedThrowTo(cap,source,target); *out = target; return THROWTO_BLOCKED; } @@ -279,12 +283,18 @@ check_target: // ASSUMPTION: tso->block_info must always point to a // closure. In the threaded RTS it does. - if (get_itbl(mvar)->type != MVAR) goto retry; + switch (get_itbl(mvar)->type) { + case MVAR_CLEAN: + case MVAR_DIRTY: + break; + default: + goto retry; + } info = lockClosure((StgClosure *)mvar); if (target->what_next == ThreadRelocated) { - target = target->link; + target = target->_link; unlockClosure((StgClosure *)mvar,info); goto retry; } @@ -299,12 +309,12 @@ check_target: if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { lockClosure((StgClosure *)target); - blockedThrowTo(source,target); + blockedThrowTo(cap,source,target); unlockClosure((StgClosure *)mvar, info); *out = target; return THROWTO_BLOCKED; // caller releases TSO } else { - removeThreadFromMVarQueue(mvar, target); + removeThreadFromMVarQueue(cap, mvar, target); raiseAsync(cap, target, exception, rtsFalse, NULL); unblockOne(cap, target); unlockClosure((StgClosure *)mvar, info); @@ -323,12 +333,12 @@ check_target: if (target->flags & TSO_BLOCKEX) { lockTSO(target); - blockedThrowTo(source,target); + blockedThrowTo(cap,source,target); RELEASE_LOCK(&sched_mutex); *out = target; return THROWTO_BLOCKED; // caller releases TSO } else { - removeThreadFromQueue(&blackhole_queue, target); + removeThreadFromQueue(cap, &blackhole_queue, target); raiseAsync(cap, target, exception, rtsFalse, NULL); unblockOne(cap, target); RELEASE_LOCK(&sched_mutex); @@ -363,12 +373,12 @@ check_target: goto retry; } if (target->what_next == ThreadRelocated) { - target = target->link; + target = target->_link; unlockTSO(target2); goto retry; } if (target2->what_next == ThreadRelocated) { - target->block_info.tso = target2->link; + target->block_info.tso = target2->_link; unlockTSO(target2); goto retry; } @@ -387,12 +397,12 @@ check_target: if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { lockTSO(target); - blockedThrowTo(source,target); + blockedThrowTo(cap,source,target); unlockTSO(target2); *out = target; return THROWTO_BLOCKED; } else { - removeThreadFromQueue(&target2->blocked_exceptions, target); + removeThreadFromQueue(cap, &target2->blocked_exceptions, target); raiseAsync(cap, target, exception, rtsFalse, NULL); unblockOne(cap, target); unlockTSO(target2); @@ -401,7 +411,23 @@ check_target: } case BlockedOnSTM: - barf("ToDo"); + lockTSO(target); + // Unblocking BlockedOnSTM threads requires the TSO to be + // locked; see STM.c:unpark_tso(). + if (target->why_blocked != BlockedOnSTM) { + goto retry; + } + if ((target->flags & TSO_BLOCKEX) && + ((target->flags & TSO_INTERRUPTIBLE) == 0)) { + blockedThrowTo(cap,source,target); + *out = target; + return THROWTO_BLOCKED; + } else { + raiseAsync(cap, target, exception, rtsFalse, NULL); + unblockOne(cap, target); + unlockTSO(target); + return THROWTO_SUCCESS; + } case BlockedOnCCall: case BlockedOnCCall_NoUnblockExc: @@ -410,7 +436,7 @@ check_target: // thread is blocking exceptions, and block on its // blocked_exception queue. lockTSO(target); - blockedThrowTo(source,target); + blockedThrowTo(cap,source,target); *out = target; return THROWTO_BLOCKED; @@ -418,9 +444,12 @@ check_target: case BlockedOnRead: case BlockedOnWrite: case BlockedOnDelay: +#if defined(mingw32_HOST_OS) + case BlockedOnDoProc: +#endif if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { - blockedThrowTo(source,target); + blockedThrowTo(cap,source,target); return THROWTO_BLOCKED; } else { removeFromQueues(cap,target); @@ -440,15 +469,15 @@ check_target: // complex to achieve as there's no single lock on a TSO; see // throwTo()). static void -blockedThrowTo (StgTSO *source, StgTSO *target) +blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target) { - debugTrace(DEBUG_sched, "throwTo: blocking on thread %d", target->id); - source->link = target->blocked_exceptions; + debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id); + setTSOLink(cap, source, target->blocked_exceptions); target->blocked_exceptions = source; - dirtyTSO(target); // we modified the blocked_exceptions queue + dirty_TSO(cap,target); // we modified the blocked_exceptions queue source->block_info.tso = target; - wb(); // throwTo_exception *must* be visible if BlockedOnException is. + write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is. source->why_blocked = BlockedOnException; } @@ -474,13 +503,20 @@ throwToReleaseTarget (void *tso) queue, but not perform any throwTo() immediately. This might be more appropriate when the target thread is the one actually running (see Exception.cmm). + + Returns: non-zero if an exception was raised, zero otherwise. -------------------------------------------------------------------------- */ -void +int maybePerformBlockedException (Capability *cap, StgTSO *tso) { StgTSO *source; + if (tso->blocked_exceptions != END_TSO_QUEUE && + (tso->flags & TSO_BLOCKEX) != 0) { + debugTrace(DEBUG_sched, "throwTo: thread %lu has blocked exceptions but is inside block", (unsigned long)tso->id); + } + if (tso->blocked_exceptions != END_TSO_QUEUE && ((tso->flags & TSO_BLOCKEX) == 0 || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) { @@ -492,7 +528,7 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) // locked it. if (tso->blocked_exceptions == END_TSO_QUEUE) { unlockTSO(tso); - return; + return 0; } // We unblock just the first thread on the queue, and perform @@ -502,7 +538,9 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) tso->blocked_exceptions = unblockOne_(cap, source, rtsFalse/*no migrate*/); unlockTSO(tso); + return 1; } + return 0; } void @@ -682,7 +720,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) } default: - barf("removeFromQueues"); + barf("removeFromQueues: %d", tso->why_blocked); } done: @@ -710,11 +748,11 @@ removeFromQueues(Capability *cap, StgTSO *tso) goto done; case BlockedOnMVar: - removeThreadFromMVarQueue((StgMVar *)tso->block_info.closure, tso); + removeThreadFromMVarQueue(cap, (StgMVar *)tso->block_info.closure, tso); goto done; case BlockedOnBlackHole: - removeThreadFromQueue(&blackhole_queue, tso); + removeThreadFromQueue(cap, &blackhole_queue, tso); goto done; case BlockedOnException: @@ -727,10 +765,10 @@ removeFromQueues(Capability *cap, StgTSO *tso) // ASSERT(get_itbl(target)->type == TSO); while (target->what_next == ThreadRelocated) { - target = target->link; + target = target->_link; } - removeThreadFromQueue(&target->blocked_exceptions, tso); + removeThreadFromQueue(cap, &target->blocked_exceptions, tso); goto done; } @@ -740,7 +778,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) #if defined(mingw32_HOST_OS) case BlockedOnDoProc: #endif - removeThreadFromDeQueue(&blocked_queue_hd, &blocked_queue_tl, tso); + removeThreadFromDeQueue(cap, &blocked_queue_hd, &blocked_queue_tl, tso); #if defined(mingw32_HOST_OS) /* (Cooperatively) signal that the worker thread should abort * the request. @@ -750,16 +788,16 @@ removeFromQueues(Capability *cap, StgTSO *tso) goto done; case BlockedOnDelay: - removeThreadFromQueue(&sleeping_queue, tso); + removeThreadFromQueue(cap, &sleeping_queue, tso); goto done; #endif default: - barf("removeFromQueues"); + barf("removeFromQueues: %d", tso->why_blocked); } done: - tso->link = END_TSO_QUEUE; + tso->_link = END_TSO_QUEUE; // no write barrier reqd tso->why_blocked = NotBlocked; tso->block_info.closure = NULL; appendToRunQueue(cap,tso); @@ -820,8 +858,20 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, debugTrace(DEBUG_sched, "raising exception in thread %ld.", (long)tso->id); +#if defined(PROFILING) + /* + * Debugging tool: on raising an exception, show where we are. + * See also Exception.cmm:raisezh_fast. + * This wasn't done for asynchronous exceptions originally; see #1450 + */ + if (RtsFlags.ProfFlags.showCCSOnException) + { + fprintCCS_stderr(tso->prof.CCCS); + } +#endif + // mark it dirty; we're about to change its stack. - dirtyTSO(tso); + dirty_TSO(cap, tso); sp = tso->sp; @@ -894,21 +944,12 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, // printObj((StgClosure *)ap); // ); - // Replace the updatee with an indirection - // - // Warning: if we're in a loop, more than one update frame on - // the stack may point to the same object. Be careful not to - // overwrite an IND_OLDGEN in this case, because we'll screw - // up the mutable lists. To be on the safe side, don't - // overwrite any kind of indirection at all. See also - // threadSqueezeStack in GC.c, where we have to make a similar - // check. - // - if (!closure_IND(((StgUpdateFrame *)frame)->updatee)) { - // revert the black hole - UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee, - (StgClosure *)ap); - } + // Perform the update + // TODO: this may waste some work, if the thunk has + // already been updated by another thread. + UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee, + (StgClosure *)ap); + sp += sizeofW(StgUpdateFrame) - 1; sp[0] = (W_)ap; // push onto stack frame = sp + 1; @@ -916,10 +957,12 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, } case STOP_FRAME: + { // We've stripped the entire stack, the thread is now dead. tso->what_next = ThreadKilled; tso->sp = frame + sizeofW(StgStopFrame); return; + } case CATCH_FRAME: // If we find a CATCH_FRAME, and we've got an exception to raise, @@ -991,14 +1034,17 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, // whether the transaction is valid or not because its // possible validity cannot have caused the exception // and will not be visible after the abort. - debugTrace(DEBUG_stm, - "found atomically block delivering async exception"); + { StgTRecHeader *trec = tso -> trec; StgTRecHeader *outer = stmGetEnclosingTRec(trec); + debugTrace(DEBUG_stm, + "found atomically block delivering async exception"); stmAbortTransaction(cap, trec); + stmFreeAbortedTRec(cap, trec); tso -> trec = outer; break; + }; default: break;