X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=d892e9563866a39e3f13fcd40e0274b87876735f;hb=0d88de0b114a391712bc117d42928b49fba4d66a;hp=95e2492efcd9c3e015d7a5b1643f4688c16d14cd;hpb=1ca9b6f8f22b58898b42bcb5b1017a85f4ab06a7;p=ghc-hetmet.git diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index 95e2492..d892e95 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -13,7 +13,6 @@ #include "RaiseAsync.h" #include "SMP.h" #include "Schedule.h" -#include "Storage.h" #include "LdvProfile.h" #include "Updates.h" #include "STM.h" @@ -438,6 +437,9 @@ 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); @@ -494,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; @@ -512,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 @@ -522,7 +526,9 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) tso->blocked_exceptions = unblockOne_(cap, source, rtsFalse/*no migrate*/); unlockTSO(tso); + return 1; } + return 0; } void @@ -1017,6 +1023,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, StgTRecHeader *trec = tso -> trec; StgTRecHeader *outer = stmGetEnclosingTRec(trec); stmAbortTransaction(cap, trec); + stmFreeAbortedTRec(cap, trec); tso -> trec = outer; break;