X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=b71e126f04020bf82ac3c8dd07a52519ebf1462a;hp=4a405e7b4909f23511e822873c50e3184670fe26;hb=45202530612593a0ba7a6c559a38dc1ff26670a4;hpb=ab0e778ccfde61aed4c22679b24d175fc6cc9bf3 diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index 4a405e7..b71e126 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -12,7 +12,6 @@ #include "Trace.h" #include "RaiseAsync.h" #include "SMP.h" -#include "Storage.h" #include "Schedule.h" #include "LdvProfile.h" #include "Updates.h" @@ -497,9 +496,11 @@ 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; @@ -515,7 +516,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 @@ -525,7 +526,9 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) tso->blocked_exceptions = unblockOne_(cap, source, rtsFalse/*no migrate*/); unlockTSO(tso); + return 1; } + return 0; } void @@ -939,10 +942,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, @@ -1014,15 +1019,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;