X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=e65cea3bfd99ccac1705bec5e7ef8d43a789f2a2;hb=9fd3a4f8760c7e47eb5d4a098559c980d24a9775;hp=9d03d07ab4be23cb9e7fc4b5e5eb5a1081f5adbe;hpb=04cddd339c000df6d02c90ce59dbffa58d2fe166;p=ghc-hetmet.git diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index 9d03d07..e65cea3 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -26,7 +26,7 @@ static void raiseAsync (Capability *cap, StgTSO *tso, StgClosure *exception, rtsBool stop_at_atomically, - StgPtr stop_here); + StgUpdateFrame *stop_here); static void removeFromQueues(Capability *cap, StgTSO *tso); @@ -55,12 +55,12 @@ static void performBlockedException (Capability *cap, void throwToSingleThreaded(Capability *cap, StgTSO *tso, StgClosure *exception) { - throwToSingleThreaded_(cap, tso, exception, rtsFalse, NULL); + throwToSingleThreaded_(cap, tso, exception, rtsFalse); } void throwToSingleThreaded_(Capability *cap, StgTSO *tso, StgClosure *exception, - rtsBool stop_at_atomically, StgPtr stop_here) + rtsBool stop_at_atomically) { // Thread already dead? if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) { @@ -70,11 +70,11 @@ throwToSingleThreaded_(Capability *cap, StgTSO *tso, StgClosure *exception, // Remove it from any blocking queues removeFromQueues(cap,tso); - raiseAsync(cap, tso, exception, stop_at_atomically, stop_here); + raiseAsync(cap, tso, exception, stop_at_atomically, NULL); } void -suspendComputation(Capability *cap, StgTSO *tso, StgPtr stop_here) +suspendComputation(Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here) { // Thread already dead? if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) { @@ -415,6 +415,7 @@ check_target: // Unblocking BlockedOnSTM threads requires the TSO to be // locked; see STM.c:unpark_tso(). if (target->why_blocked != BlockedOnSTM) { + unlockTSO(target); goto retry; } if ((target->flags & TSO_BLOCKEX) && @@ -436,6 +437,11 @@ check_target: // thread is blocking exceptions, and block on its // blocked_exception queue. lockTSO(target); + if (target->why_blocked != BlockedOnCCall && + target->why_blocked != BlockedOnCCall_NoUnblockExc) { + unlockTSO(target); + goto retry; + } blockedThrowTo(cap,source,target); *out = target; return THROWTO_BLOCKED; @@ -512,6 +518,15 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) { StgTSO *source; + if (tso->what_next == ThreadComplete || tso->what_next == ThreadFinished) { + if (tso->blocked_exceptions != END_TSO_QUEUE) { + awakenBlockedExceptionQueue(cap,tso); + return 1; + } else { + return 0; + } + } + 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); @@ -543,6 +558,9 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso) return 0; } +// awakenBlockedExceptionQueue(): Just wake up the whole queue of +// blocked exceptions and let them try again. + void awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso) { @@ -575,161 +593,11 @@ performBlockedException (Capability *cap, StgTSO *source, StgTSO *target) This is for use when we raise an exception in another thread, which may be blocked. - This has nothing to do with the UnblockThread event in GranSim. -- HWL - -------------------------------------------------------------------------- */ - -#if defined(GRAN) || defined(PARALLEL_HASKELL) -/* - NB: only the type of the blocking queue is different in GranSim and GUM - the operations on the queue-elements are the same - long live polymorphism! - - Locks: sched_mutex is held upon entry and exit. - -*/ -static void -removeFromQueues(Capability *cap, StgTSO *tso) -{ - StgBlockingQueueElement *t, **last; - - switch (tso->why_blocked) { - - case NotBlocked: - return; /* not blocked */ - - case BlockedOnSTM: - // Be careful: nothing to do here! We tell the scheduler that the thread - // is runnable and we leave it to the stack-walking code to abort the - // transaction while unwinding the stack. We should perhaps have a debugging - // test to make sure that this really happens and that the 'zombie' transaction - // does not get committed. - goto done; - - case BlockedOnMVar: - ASSERT(get_itbl(tso->block_info.closure)->type == MVAR); - { - StgBlockingQueueElement *last_tso = END_BQ_QUEUE; - StgMVar *mvar = (StgMVar *)(tso->block_info.closure); - - last = (StgBlockingQueueElement **)&mvar->head; - for (t = (StgBlockingQueueElement *)mvar->head; - t != END_BQ_QUEUE; - last = &t->link, last_tso = t, t = t->link) { - if (t == (StgBlockingQueueElement *)tso) { - *last = (StgBlockingQueueElement *)tso->link; - if (mvar->tail == tso) { - mvar->tail = (StgTSO *)last_tso; - } - goto done; - } - } - barf("removeFromQueues (MVAR): TSO not found"); - } - - case BlockedOnBlackHole: - ASSERT(get_itbl(tso->block_info.closure)->type == BLACKHOLE_BQ); - { - StgBlockingQueue *bq = (StgBlockingQueue *)(tso->block_info.closure); - - last = &bq->blocking_queue; - for (t = bq->blocking_queue; - t != END_BQ_QUEUE; - last = &t->link, t = t->link) { - if (t == (StgBlockingQueueElement *)tso) { - *last = (StgBlockingQueueElement *)tso->link; - goto done; - } - } - barf("removeFromQueues (BLACKHOLE): TSO not found"); - } - - case BlockedOnException: - { - StgTSO *target = tso->block_info.tso; - - ASSERT(get_itbl(target)->type == TSO); - while (target->what_next == ThreadRelocated) { - target = target2->link; - ASSERT(get_itbl(target)->type == TSO); - } - - last = (StgBlockingQueueElement **)&target->blocked_exceptions; - for (t = (StgBlockingQueueElement *)target->blocked_exceptions; - t != END_BQ_QUEUE; - last = &t->link, t = t->link) { - ASSERT(get_itbl(t)->type == TSO); - if (t == (StgBlockingQueueElement *)tso) { - *last = (StgBlockingQueueElement *)tso->link; - goto done; - } - } - barf("removeFromQueues (Exception): TSO not found"); - } - - case BlockedOnRead: - case BlockedOnWrite: -#if defined(mingw32_HOST_OS) - case BlockedOnDoProc: -#endif - { - /* take TSO off blocked_queue */ - StgBlockingQueueElement *prev = NULL; - for (t = (StgBlockingQueueElement *)blocked_queue_hd; t != END_BQ_QUEUE; - prev = t, t = t->link) { - if (t == (StgBlockingQueueElement *)tso) { - if (prev == NULL) { - blocked_queue_hd = (StgTSO *)t->link; - if ((StgBlockingQueueElement *)blocked_queue_tl == t) { - blocked_queue_tl = END_TSO_QUEUE; - } - } else { - prev->link = t->link; - if ((StgBlockingQueueElement *)blocked_queue_tl == t) { - blocked_queue_tl = (StgTSO *)prev; - } - } -#if defined(mingw32_HOST_OS) - /* (Cooperatively) signal that the worker thread should abort - * the request. - */ - abandonWorkRequest(tso->block_info.async_result->reqID); -#endif - goto done; - } - } - barf("removeFromQueues (I/O): TSO not found"); - } - - case BlockedOnDelay: - { - /* take TSO off sleeping_queue */ - StgBlockingQueueElement *prev = NULL; - for (t = (StgBlockingQueueElement *)sleeping_queue; t != END_BQ_QUEUE; - prev = t, t = t->link) { - if (t == (StgBlockingQueueElement *)tso) { - if (prev == NULL) { - sleeping_queue = (StgTSO *)t->link; - } else { - prev->link = t->link; - } - goto done; - } - } - barf("removeFromQueues (delay): TSO not found"); - } - - default: - barf("removeFromQueues: %d", tso->why_blocked); - } + Precondition: we have exclusive access to the TSO, via the same set + of conditions as throwToSingleThreaded() (c.f.). + -------------------------------------------------------------------------- */ - done: - tso->link = END_TSO_QUEUE; - tso->why_blocked = NotBlocked; - tso->block_info.closure = NULL; - pushOnRunQueue(cap,tso); -} -#else static void removeFromQueues(Capability *cap, StgTSO *tso) { @@ -808,7 +676,6 @@ removeFromQueues(Capability *cap, StgTSO *tso) } tso->cap = cap; } -#endif /* ----------------------------------------------------------------------------- * raiseAsync() @@ -849,10 +716,11 @@ removeFromQueues(Capability *cap, StgTSO *tso) static void raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, - rtsBool stop_at_atomically, StgPtr stop_here) + rtsBool stop_at_atomically, StgUpdateFrame *stop_here) { StgRetInfoTable *info; StgPtr sp, frame; + StgClosure *updatee; nat i; debugTrace(DEBUG_sched, @@ -879,6 +747,12 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, // layers should deal with that. ASSERT(tso->what_next != ThreadComplete && tso->what_next != ThreadKilled); + if (stop_here != NULL) { + updatee = stop_here->updatee; + } else { + updatee = NULL; + } + // The stack freezing code assumes there's a closure pointer on // the top of the stack, so we have to arrange that this is the case... // @@ -890,7 +764,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, } frame = sp + 1; - while (stop_here == NULL || frame < stop_here) { + while (stop_here == NULL || frame < (StgPtr)stop_here) { // 1. Let the top of the stack be the "current closure" // @@ -944,11 +818,19 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, // printObj((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); + if (((StgUpdateFrame *)frame)->updatee == updatee) { + // If this update frame points to the same closure as + // the update frame further down the stack + // (stop_here), then don't perform the update. We + // want to keep the blackhole in this case, so we can + // detect and report the loop (#2783). + ap = (StgAP_STACK*)updatee; + } else { + // Perform the update + // TODO: this may waste some work, if the thunk has + // already been updated by another thread. + UPD_IND(((StgUpdateFrame *)frame)->updatee, (StgClosure *)ap); + } sp += sizeofW(StgUpdateFrame) - 1; sp[0] = (W_)ap; // push onto stack @@ -1010,23 +892,14 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, 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; } // Not stop_at_atomically... fall through and abort the // transaction. + case CATCH_STM_FRAME: case CATCH_RETRY_FRAME: // IF we find an ATOMICALLY_FRAME then we abort the // current transaction and propagate the exception. In