#include "Updates.h"
#include "STM.h"
#include "Sanity.h"
+#include "Profiling.h"
#if defined(mingw32_HOST_OS)
#include "win32/IOManager.h"
#endif
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);
// 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);
}
// 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;
}
// 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;
}
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);
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);
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;
}
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);
}
if ((target->flags & TSO_BLOCKEX) &&
((target->flags & TSO_INTERRUPTIBLE) == 0)) {
- blockedThrowTo(source,target);
+ blockedThrowTo(cap,source,target);
*out = target;
return THROWTO_BLOCKED;
} else {
// 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;
#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);
// 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 %lu", (unsigned long)target->id);
- source->link = target->blocked_exceptions;
+ 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;
write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
{
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)))) {
}
default:
- barf("removeFromQueues");
+ barf("removeFromQueues: %d", tso->why_blocked);
}
done:
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:
// 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;
}
#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.
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);
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;
// 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;
if (stop_at_atomically) {
ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
stmCondemnTransaction(cap, tso -> trec);
-#ifdef REG_R1
tso->sp = frame;
-#else
- // R1 is not a register: the return convention for IO in
- // this case puts the return value on the stack, so we
- // need to set up the stack to return to the atomically
- // frame properly...
- tso->sp = frame - 2;
- tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
- tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
-#endif
tso->what_next = ThreadRunGHC;
return;
}
projects / ghc-hetmet.git / blobdiff