#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,
// 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)) {
{
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
// 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);
}
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(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:
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);
static void
blockedThrowTo (StgTSO *source, StgTSO *target)
{
- debugTrace(DEBUG_sched, "throwTo: blocking on thread %d", target->id);
+ debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
source->link = target->blocked_exceptions;
target->blocked_exceptions = source;
dirtyTSO(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;
}
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)))) {
// 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
tso->blocked_exceptions = unblockOne_(cap, source,
rtsFalse/*no migrate*/);
unlockTSO(tso);
+ return 1;
}
+ return 0;
}
void
}
default:
- barf("removeFromQueues");
+ barf("removeFromQueues: %d", tso->why_blocked);
}
done:
#endif
default:
- barf("removeFromQueues");
+ barf("removeFromQueues: %d", tso->why_blocked);
}
done:
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);
// 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;
}
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,
// 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;
projects / ghc-hetmet.git / blobdiff