1 /* ---------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2006
5 * Asynchronous exceptions
7 * --------------------------------------------------------------------------*/
9 #include "PosixSource.h"
13 #include "RaiseAsync.h"
17 #include "LdvProfile.h"
21 #if defined(mingw32_HOST_OS)
22 #include "win32/IOManager.h"
25 static void raiseAsync (Capability *cap,
27 StgClosure *exception,
28 rtsBool stop_at_atomically,
31 static void removeFromQueues(Capability *cap, StgTSO *tso);
33 static void blockedThrowTo (StgTSO *source, StgTSO *target);
35 static void performBlockedException (Capability *cap,
36 StgTSO *source, StgTSO *target);
38 /* -----------------------------------------------------------------------------
41 This version of throwTo is safe to use if and only if one of the
46 - all the other threads in the system are stopped (eg. during GC).
48 - we surely own the target TSO (eg. we just took it from the
49 run queue of the current capability, or we are running it).
51 It doesn't cater for blocking the source thread until the exception
53 -------------------------------------------------------------------------- */
56 throwToSingleThreaded(Capability *cap, StgTSO *tso, StgClosure *exception)
58 throwToSingleThreaded_(cap, tso, exception, rtsFalse, NULL);
62 throwToSingleThreaded_(Capability *cap, StgTSO *tso, StgClosure *exception,
63 rtsBool stop_at_atomically, StgPtr stop_here)
65 // Thread already dead?
66 if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
70 // Remove it from any blocking queues
71 removeFromQueues(cap,tso);
73 raiseAsync(cap, tso, exception, stop_at_atomically, stop_here);
77 suspendComputation(Capability *cap, StgTSO *tso, StgPtr stop_here)
79 // Thread already dead?
80 if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
84 // Remove it from any blocking queues
85 removeFromQueues(cap,tso);
87 raiseAsync(cap, tso, NULL, rtsFalse, stop_here);
90 /* -----------------------------------------------------------------------------
93 This function may be used to throw an exception from one thread to
94 another, during the course of normal execution. This is a tricky
95 task: the target thread might be running on another CPU, or it
96 may be blocked and could be woken up at any point by another CPU.
97 We have some delicate synchronisation to do.
99 There is a completely safe fallback scheme: it is always possible
100 to just block the source TSO on the target TSO's blocked_exceptions
101 queue. This queue is locked using lockTSO()/unlockTSO(). It is
102 checked at regular intervals: before and after running a thread
103 (schedule() and threadPaused() respectively), and just before GC
104 (scheduleDoGC()). Activating a thread on this queue should be done
105 using maybePerformBlockedException(): this is done in the context
106 of the target thread, so the exception can be raised eagerly.
108 This fallback scheme works even if the target thread is complete or
109 killed: scheduleDoGC() will discover the blocked thread before the
112 Blocking the source thread on the target thread's blocked_exception
113 queue is also employed when the target thread is currently blocking
114 exceptions (ie. inside Control.Exception.block).
116 We could use the safe fallback scheme exclusively, but that
117 wouldn't be ideal: most calls to throwTo would block immediately,
118 possibly until the next GC, which might require the deadlock
119 detection mechanism to kick in. So we try to provide promptness
122 We can promptly deliver the exception if the target thread is:
124 - runnable, on the same Capability as the source thread (because
125 we own the run queue and therefore the target thread).
127 - blocked, and we can obtain exclusive access to it. Obtaining
128 exclusive access to the thread depends on how it is blocked.
130 We must also be careful to not trip over threadStackOverflow(),
131 which might be moving the TSO to enlarge its stack.
132 lockTSO()/unlockTSO() are used here too.
136 THROWTO_SUCCESS exception was raised, ok to continue
138 THROWTO_BLOCKED exception was not raised; block the source
139 thread then call throwToReleaseTarget() when
140 the source thread is properly tidied away.
142 -------------------------------------------------------------------------- */
145 throwTo (Capability *cap, // the Capability we hold
146 StgTSO *source, // the TSO sending the exception
147 StgTSO *target, // the TSO receiving the exception
148 StgClosure *exception, // the exception closure
149 /*[out]*/ void **out USED_IF_THREADS)
153 // follow ThreadRelocated links in the target first
154 while (target->what_next == ThreadRelocated) {
155 target = target->link;
156 // No, it might be a WHITEHOLE:
157 // ASSERT(get_itbl(target)->type == TSO);
160 debugTrace(DEBUG_sched, "throwTo: from thread %lu to thread %lu",
161 (unsigned long)source->id, (unsigned long)target->id);
164 if (traceClass(DEBUG_sched)) {
165 debugTraceBegin("throwTo: target");
166 printThreadStatus(target);
173 debugTrace(DEBUG_sched, "throwTo: retrying...");
176 // Thread already dead?
177 if (target->what_next == ThreadComplete
178 || target->what_next == ThreadKilled) {
179 return THROWTO_SUCCESS;
182 status = target->why_blocked;
186 /* if status==NotBlocked, and target->cap == cap, then
187 we own this TSO and can raise the exception.
189 How do we establish this condition? Very carefully.
192 P = (status == NotBlocked)
193 Q = (tso->cap == cap)
195 Now, if P & Q are true, then the TSO is locked and owned by
196 this capability. No other OS thread can steal it.
198 If P==0 and Q==1: the TSO is blocked, but attached to this
199 capabilty, and it can be stolen by another capability.
201 If P==1 and Q==0: the TSO is runnable on another
202 capability. At any time, the TSO may change from runnable
203 to blocked and vice versa, while it remains owned by
206 Suppose we test like this:
212 this is defeated by another capability stealing a blocked
213 TSO from us to wake it up (Schedule.c:unblockOne()). The
214 other thread is doing
219 assuming arbitrary reordering, we could see this
229 so we need a memory barrier:
236 this avoids the problematic case. There are other cases
237 to consider, but this is the tricky one.
239 Note that we must be sure that unblockOne() does the
240 writes in the correct order: Q before P. The memory
241 barrier ensures that if we have seen the write to P, we
242 have also seen the write to Q.
245 Capability *target_cap;
248 target_cap = target->cap;
249 if (target_cap == cap && (target->flags & TSO_BLOCKEX) == 0) {
250 // It's on our run queue and not blocking exceptions
251 raiseAsync(cap, target, exception, rtsFalse, NULL);
252 return THROWTO_SUCCESS;
254 // Otherwise, just block on the blocked_exceptions queue
255 // of the target thread. The queue will get looked at
256 // soon enough: it is checked before and after running a
257 // thread, and during GC.
260 // Avoid race with threadStackOverflow, which may have
261 // just moved this TSO.
262 if (target->what_next == ThreadRelocated) {
264 target = target->link;
267 blockedThrowTo(source,target);
269 return THROWTO_BLOCKED;
276 To establish ownership of this TSO, we need to acquire a
277 lock on the MVar that it is blocked on.
280 StgInfoTable *info USED_IF_THREADS;
282 mvar = (StgMVar *)target->block_info.closure;
284 // ASSUMPTION: tso->block_info must always point to a
285 // closure. In the threaded RTS it does.
286 if (get_itbl(mvar)->type != MVAR) goto retry;
288 info = lockClosure((StgClosure *)mvar);
290 if (target->what_next == ThreadRelocated) {
291 target = target->link;
292 unlockClosure((StgClosure *)mvar,info);
295 // we have the MVar, let's check whether the thread
296 // is still blocked on the same MVar.
297 if (target->why_blocked != BlockedOnMVar
298 || (StgMVar *)target->block_info.closure != mvar) {
299 unlockClosure((StgClosure *)mvar, info);
303 if ((target->flags & TSO_BLOCKEX) &&
304 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
305 lockClosure((StgClosure *)target);
306 blockedThrowTo(source,target);
307 unlockClosure((StgClosure *)mvar, info);
309 return THROWTO_BLOCKED; // caller releases TSO
311 removeThreadFromMVarQueue(mvar, target);
312 raiseAsync(cap, target, exception, rtsFalse, NULL);
313 unblockOne(cap, target);
314 unlockClosure((StgClosure *)mvar, info);
315 return THROWTO_SUCCESS;
319 case BlockedOnBlackHole:
321 ACQUIRE_LOCK(&sched_mutex);
322 // double checking the status after the memory barrier:
323 if (target->why_blocked != BlockedOnBlackHole) {
324 RELEASE_LOCK(&sched_mutex);
328 if (target->flags & TSO_BLOCKEX) {
330 blockedThrowTo(source,target);
331 RELEASE_LOCK(&sched_mutex);
333 return THROWTO_BLOCKED; // caller releases TSO
335 removeThreadFromQueue(&blackhole_queue, target);
336 raiseAsync(cap, target, exception, rtsFalse, NULL);
337 unblockOne(cap, target);
338 RELEASE_LOCK(&sched_mutex);
339 return THROWTO_SUCCESS;
343 case BlockedOnException:
349 To obtain exclusive access to a BlockedOnException thread,
350 we must call lockClosure() on the TSO on which it is blocked.
351 Since the TSO might change underneath our feet, after we
352 call lockClosure() we must check that
354 (a) the closure we locked is actually a TSO
355 (b) the original thread is still BlockedOnException,
356 (c) the original thread is still blocked on the TSO we locked
357 and (d) the target thread has not been relocated.
359 We synchronise with threadStackOverflow() (which relocates
360 threads) using lockClosure()/unlockClosure().
362 target2 = target->block_info.tso;
364 info = lockClosure((StgClosure *)target2);
365 if (info != &stg_TSO_info) {
366 unlockClosure((StgClosure *)target2, info);
369 if (target->what_next == ThreadRelocated) {
370 target = target->link;
374 if (target2->what_next == ThreadRelocated) {
375 target->block_info.tso = target2->link;
379 if (target->why_blocked != BlockedOnException
380 || target->block_info.tso != target2) {
386 Now we have exclusive rights to the target TSO...
388 If it is blocking exceptions, add the source TSO to its
389 blocked_exceptions queue. Otherwise, raise the exception.
391 if ((target->flags & TSO_BLOCKEX) &&
392 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
394 blockedThrowTo(source,target);
397 return THROWTO_BLOCKED;
399 removeThreadFromQueue(&target2->blocked_exceptions, target);
400 raiseAsync(cap, target, exception, rtsFalse, NULL);
401 unblockOne(cap, target);
403 return THROWTO_SUCCESS;
409 // Unblocking BlockedOnSTM threads requires the TSO to be
410 // locked; see STM.c:unpark_tso().
411 if (target->why_blocked != BlockedOnSTM) {
414 if ((target->flags & TSO_BLOCKEX) &&
415 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
416 blockedThrowTo(source,target);
418 return THROWTO_BLOCKED;
420 raiseAsync(cap, target, exception, rtsFalse, NULL);
421 unblockOne(cap, target);
423 return THROWTO_SUCCESS;
427 case BlockedOnCCall_NoUnblockExc:
428 // I don't think it's possible to acquire ownership of a
429 // BlockedOnCCall thread. We just assume that the target
430 // thread is blocking exceptions, and block on its
431 // blocked_exception queue.
433 blockedThrowTo(source,target);
435 return THROWTO_BLOCKED;
437 #ifndef THREADEDED_RTS
441 #if defined(mingw32_HOST_OS)
442 case BlockedOnDoProc:
444 if ((target->flags & TSO_BLOCKEX) &&
445 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
446 blockedThrowTo(source,target);
447 return THROWTO_BLOCKED;
449 removeFromQueues(cap,target);
450 raiseAsync(cap, target, exception, rtsFalse, NULL);
451 return THROWTO_SUCCESS;
456 barf("throwTo: unrecognised why_blocked value");
461 // Block a TSO on another TSO's blocked_exceptions queue.
462 // Precondition: we hold an exclusive lock on the target TSO (this is
463 // complex to achieve as there's no single lock on a TSO; see
466 blockedThrowTo (StgTSO *source, StgTSO *target)
468 debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
469 source->link = target->blocked_exceptions;
470 target->blocked_exceptions = source;
471 dirtyTSO(target); // we modified the blocked_exceptions queue
473 source->block_info.tso = target;
474 write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
475 source->why_blocked = BlockedOnException;
481 throwToReleaseTarget (void *tso)
483 unlockTSO((StgTSO *)tso);
487 /* -----------------------------------------------------------------------------
488 Waking up threads blocked in throwTo
490 There are two ways to do this: maybePerformBlockedException() will
491 perform the throwTo() for the thread at the head of the queue
492 immediately, and leave the other threads on the queue.
493 maybePerformBlockedException() also checks the TSO_BLOCKEX flag
494 before raising an exception.
496 awakenBlockedExceptionQueue() will wake up all the threads in the
497 queue, but not perform any throwTo() immediately. This might be
498 more appropriate when the target thread is the one actually running
500 -------------------------------------------------------------------------- */
503 maybePerformBlockedException (Capability *cap, StgTSO *tso)
507 if (tso->blocked_exceptions != END_TSO_QUEUE
508 && ((tso->flags & TSO_BLOCKEX) == 0
509 || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) {
511 // Lock the TSO, this gives us exclusive access to the queue
514 // Check the queue again; it might have changed before we
516 if (tso->blocked_exceptions == END_TSO_QUEUE) {
521 // We unblock just the first thread on the queue, and perform
522 // its throw immediately.
523 source = tso->blocked_exceptions;
524 performBlockedException(cap, source, tso);
525 tso->blocked_exceptions = unblockOne_(cap, source,
526 rtsFalse/*no migrate*/);
532 awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso)
534 if (tso->blocked_exceptions != END_TSO_QUEUE) {
536 awakenBlockedQueue(cap, tso->blocked_exceptions);
537 tso->blocked_exceptions = END_TSO_QUEUE;
543 performBlockedException (Capability *cap, StgTSO *source, StgTSO *target)
545 StgClosure *exception;
547 ASSERT(source->why_blocked == BlockedOnException);
548 ASSERT(source->block_info.tso->id == target->id);
549 ASSERT(source->sp[0] == (StgWord)&stg_block_throwto_info);
550 ASSERT(((StgTSO *)source->sp[1])->id == target->id);
551 // check ids not pointers, because the thread might be relocated
553 exception = (StgClosure *)source->sp[2];
554 throwToSingleThreaded(cap, target, exception);
558 /* -----------------------------------------------------------------------------
559 Remove a thread from blocking queues.
561 This is for use when we raise an exception in another thread, which
563 This has nothing to do with the UnblockThread event in GranSim. -- HWL
564 -------------------------------------------------------------------------- */
566 #if defined(GRAN) || defined(PARALLEL_HASKELL)
568 NB: only the type of the blocking queue is different in GranSim and GUM
569 the operations on the queue-elements are the same
570 long live polymorphism!
572 Locks: sched_mutex is held upon entry and exit.
576 removeFromQueues(Capability *cap, StgTSO *tso)
578 StgBlockingQueueElement *t, **last;
580 switch (tso->why_blocked) {
583 return; /* not blocked */
586 // Be careful: nothing to do here! We tell the scheduler that the thread
587 // is runnable and we leave it to the stack-walking code to abort the
588 // transaction while unwinding the stack. We should perhaps have a debugging
589 // test to make sure that this really happens and that the 'zombie' transaction
590 // does not get committed.
594 ASSERT(get_itbl(tso->block_info.closure)->type == MVAR);
596 StgBlockingQueueElement *last_tso = END_BQ_QUEUE;
597 StgMVar *mvar = (StgMVar *)(tso->block_info.closure);
599 last = (StgBlockingQueueElement **)&mvar->head;
600 for (t = (StgBlockingQueueElement *)mvar->head;
602 last = &t->link, last_tso = t, t = t->link) {
603 if (t == (StgBlockingQueueElement *)tso) {
604 *last = (StgBlockingQueueElement *)tso->link;
605 if (mvar->tail == tso) {
606 mvar->tail = (StgTSO *)last_tso;
611 barf("removeFromQueues (MVAR): TSO not found");
614 case BlockedOnBlackHole:
615 ASSERT(get_itbl(tso->block_info.closure)->type == BLACKHOLE_BQ);
617 StgBlockingQueue *bq = (StgBlockingQueue *)(tso->block_info.closure);
619 last = &bq->blocking_queue;
620 for (t = bq->blocking_queue;
622 last = &t->link, t = t->link) {
623 if (t == (StgBlockingQueueElement *)tso) {
624 *last = (StgBlockingQueueElement *)tso->link;
628 barf("removeFromQueues (BLACKHOLE): TSO not found");
631 case BlockedOnException:
633 StgTSO *target = tso->block_info.tso;
635 ASSERT(get_itbl(target)->type == TSO);
637 while (target->what_next == ThreadRelocated) {
638 target = target2->link;
639 ASSERT(get_itbl(target)->type == TSO);
642 last = (StgBlockingQueueElement **)&target->blocked_exceptions;
643 for (t = (StgBlockingQueueElement *)target->blocked_exceptions;
645 last = &t->link, t = t->link) {
646 ASSERT(get_itbl(t)->type == TSO);
647 if (t == (StgBlockingQueueElement *)tso) {
648 *last = (StgBlockingQueueElement *)tso->link;
652 barf("removeFromQueues (Exception): TSO not found");
657 #if defined(mingw32_HOST_OS)
658 case BlockedOnDoProc:
661 /* take TSO off blocked_queue */
662 StgBlockingQueueElement *prev = NULL;
663 for (t = (StgBlockingQueueElement *)blocked_queue_hd; t != END_BQ_QUEUE;
664 prev = t, t = t->link) {
665 if (t == (StgBlockingQueueElement *)tso) {
667 blocked_queue_hd = (StgTSO *)t->link;
668 if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
669 blocked_queue_tl = END_TSO_QUEUE;
672 prev->link = t->link;
673 if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
674 blocked_queue_tl = (StgTSO *)prev;
677 #if defined(mingw32_HOST_OS)
678 /* (Cooperatively) signal that the worker thread should abort
681 abandonWorkRequest(tso->block_info.async_result->reqID);
686 barf("removeFromQueues (I/O): TSO not found");
691 /* take TSO off sleeping_queue */
692 StgBlockingQueueElement *prev = NULL;
693 for (t = (StgBlockingQueueElement *)sleeping_queue; t != END_BQ_QUEUE;
694 prev = t, t = t->link) {
695 if (t == (StgBlockingQueueElement *)tso) {
697 sleeping_queue = (StgTSO *)t->link;
699 prev->link = t->link;
704 barf("removeFromQueues (delay): TSO not found");
708 barf("removeFromQueues");
712 tso->link = END_TSO_QUEUE;
713 tso->why_blocked = NotBlocked;
714 tso->block_info.closure = NULL;
715 pushOnRunQueue(cap,tso);
719 removeFromQueues(Capability *cap, StgTSO *tso)
721 switch (tso->why_blocked) {
727 // Be careful: nothing to do here! We tell the scheduler that the
728 // thread is runnable and we leave it to the stack-walking code to
729 // abort the transaction while unwinding the stack. We should
730 // perhaps have a debugging test to make sure that this really
731 // happens and that the 'zombie' transaction does not get
736 removeThreadFromMVarQueue((StgMVar *)tso->block_info.closure, tso);
739 case BlockedOnBlackHole:
740 removeThreadFromQueue(&blackhole_queue, tso);
743 case BlockedOnException:
745 StgTSO *target = tso->block_info.tso;
747 // NO: when called by threadPaused(), we probably have this
748 // TSO already locked (WHITEHOLEd) because we just placed
749 // ourselves on its queue.
750 // ASSERT(get_itbl(target)->type == TSO);
752 while (target->what_next == ThreadRelocated) {
753 target = target->link;
756 removeThreadFromQueue(&target->blocked_exceptions, tso);
760 #if !defined(THREADED_RTS)
763 #if defined(mingw32_HOST_OS)
764 case BlockedOnDoProc:
766 removeThreadFromDeQueue(&blocked_queue_hd, &blocked_queue_tl, tso);
767 #if defined(mingw32_HOST_OS)
768 /* (Cooperatively) signal that the worker thread should abort
771 abandonWorkRequest(tso->block_info.async_result->reqID);
776 removeThreadFromQueue(&sleeping_queue, tso);
781 barf("removeFromQueues");
785 tso->link = END_TSO_QUEUE;
786 tso->why_blocked = NotBlocked;
787 tso->block_info.closure = NULL;
788 appendToRunQueue(cap,tso);
790 // We might have just migrated this TSO to our Capability:
792 tso->bound->cap = cap;
798 /* -----------------------------------------------------------------------------
801 * The following function implements the magic for raising an
802 * asynchronous exception in an existing thread.
804 * We first remove the thread from any queue on which it might be
805 * blocked. The possible blockages are MVARs and BLACKHOLE_BQs.
807 * We strip the stack down to the innermost CATCH_FRAME, building
808 * thunks in the heap for all the active computations, so they can
809 * be restarted if necessary. When we reach a CATCH_FRAME, we build
810 * an application of the handler to the exception, and push it on
811 * the top of the stack.
813 * How exactly do we save all the active computations? We create an
814 * AP_STACK for every UpdateFrame on the stack. Entering one of these
815 * AP_STACKs pushes everything from the corresponding update frame
816 * upwards onto the stack. (Actually, it pushes everything up to the
817 * next update frame plus a pointer to the next AP_STACK object.
818 * Entering the next AP_STACK object pushes more onto the stack until we
819 * reach the last AP_STACK object - at which point the stack should look
820 * exactly as it did when we killed the TSO and we can continue
821 * execution by entering the closure on top of the stack.
823 * We can also kill a thread entirely - this happens if either (a) the
824 * exception passed to raiseAsync is NULL, or (b) there's no
825 * CATCH_FRAME on the stack. In either case, we strip the entire
826 * stack and replace the thread with a zombie.
828 * ToDo: in THREADED_RTS mode, this function is only safe if either
829 * (a) we hold all the Capabilities (eg. in GC, or if there is only
830 * one Capability), or (b) we own the Capability that the TSO is
831 * currently blocked on or on the run queue of.
833 * -------------------------------------------------------------------------- */
836 raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
837 rtsBool stop_at_atomically, StgPtr stop_here)
839 StgRetInfoTable *info;
843 debugTrace(DEBUG_sched,
844 "raising exception in thread %ld.", (long)tso->id);
846 // mark it dirty; we're about to change its stack.
851 // ASSUMES: the thread is not already complete or dead. Upper
852 // layers should deal with that.
853 ASSERT(tso->what_next != ThreadComplete && tso->what_next != ThreadKilled);
855 // The stack freezing code assumes there's a closure pointer on
856 // the top of the stack, so we have to arrange that this is the case...
858 if (sp[0] == (W_)&stg_enter_info) {
862 sp[0] = (W_)&stg_dummy_ret_closure;
866 while (stop_here == NULL || frame < stop_here) {
868 // 1. Let the top of the stack be the "current closure"
870 // 2. Walk up the stack until we find either an UPDATE_FRAME or a
873 // 3. If it's an UPDATE_FRAME, then make an AP_STACK containing the
874 // current closure applied to the chunk of stack up to (but not
875 // including) the update frame. This closure becomes the "current
876 // closure". Go back to step 2.
878 // 4. If it's a CATCH_FRAME, then leave the exception handler on
879 // top of the stack applied to the exception.
881 // 5. If it's a STOP_FRAME, then kill the thread.
883 // NB: if we pass an ATOMICALLY_FRAME then abort the associated
886 info = get_ret_itbl((StgClosure *)frame);
888 switch (info->i.type) {
895 // First build an AP_STACK consisting of the stack chunk above the
896 // current update frame, with the top word on the stack as the
899 words = frame - sp - 1;
900 ap = (StgAP_STACK *)allocateLocal(cap,AP_STACK_sizeW(words));
903 ap->fun = (StgClosure *)sp[0];
905 for(i=0; i < (nat)words; ++i) {
906 ap->payload[i] = (StgClosure *)*sp++;
909 SET_HDR(ap,&stg_AP_STACK_info,
910 ((StgClosure *)frame)->header.prof.ccs /* ToDo */);
911 TICK_ALLOC_UP_THK(words+1,0);
913 //IF_DEBUG(scheduler,
914 // debugBelch("sched: Updating ");
915 // printPtr((P_)((StgUpdateFrame *)frame)->updatee);
916 // debugBelch(" with ");
917 // printObj((StgClosure *)ap);
920 // Replace the updatee with an indirection
922 // Warning: if we're in a loop, more than one update frame on
923 // the stack may point to the same object. Be careful not to
924 // overwrite an IND_OLDGEN in this case, because we'll screw
925 // up the mutable lists. To be on the safe side, don't
926 // overwrite any kind of indirection at all. See also
927 // threadSqueezeStack in GC.c, where we have to make a similar
930 if (!closure_IND(((StgUpdateFrame *)frame)->updatee)) {
931 // revert the black hole
932 UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
935 sp += sizeofW(StgUpdateFrame) - 1;
936 sp[0] = (W_)ap; // push onto stack
938 continue; //no need to bump frame
942 // We've stripped the entire stack, the thread is now dead.
943 tso->what_next = ThreadKilled;
944 tso->sp = frame + sizeofW(StgStopFrame);
948 // If we find a CATCH_FRAME, and we've got an exception to raise,
949 // then build the THUNK raise(exception), and leave it on
950 // top of the CATCH_FRAME ready to enter.
954 StgCatchFrame *cf = (StgCatchFrame *)frame;
958 if (exception == NULL) break;
960 // we've got an exception to raise, so let's pass it to the
961 // handler in this frame.
963 raise = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
964 TICK_ALLOC_SE_THK(1,0);
965 SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
966 raise->payload[0] = exception;
968 // throw away the stack from Sp up to the CATCH_FRAME.
972 /* Ensure that async excpetions are blocked now, so we don't get
973 * a surprise exception before we get around to executing the
976 tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
978 /* Put the newly-built THUNK on top of the stack, ready to execute
979 * when the thread restarts.
982 sp[-1] = (W_)&stg_enter_info;
984 tso->what_next = ThreadRunGHC;
985 IF_DEBUG(sanity, checkTSO(tso));
989 case ATOMICALLY_FRAME:
990 if (stop_at_atomically) {
991 ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
992 stmCondemnTransaction(cap, tso -> trec);
996 // R1 is not a register: the return convention for IO in
997 // this case puts the return value on the stack, so we
998 // need to set up the stack to return to the atomically
1000 tso->sp = frame - 2;
1001 tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
1002 tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
1004 tso->what_next = ThreadRunGHC;
1007 // Not stop_at_atomically... fall through and abort the
1010 case CATCH_RETRY_FRAME:
1011 // IF we find an ATOMICALLY_FRAME then we abort the
1012 // current transaction and propagate the exception. In
1013 // this case (unlike ordinary exceptions) we do not care
1014 // whether the transaction is valid or not because its
1015 // possible validity cannot have caused the exception
1016 // and will not be visible after the abort.
1017 debugTrace(DEBUG_stm,
1018 "found atomically block delivering async exception");
1020 StgTRecHeader *trec = tso -> trec;
1021 StgTRecHeader *outer = stmGetEnclosingTRec(trec);
1022 stmAbortTransaction(cap, trec);
1023 tso -> trec = outer;
1030 // move on to the next stack frame
1031 frame += stack_frame_sizeW((StgClosure *)frame);
1034 // if we got here, then we stopped at stop_here
1035 ASSERT(stop_here != NULL);