FIX #2164: check for ThreadRelocated in isAlive()
[ghc.git] / rts / RaiseAsync.c
1 /* ---------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2006
4 *
5 * Asynchronous exceptions
6 *
7 * --------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10 #include "Rts.h"
11 #include "Threads.h"
12 #include "Trace.h"
13 #include "RaiseAsync.h"
14 #include "SMP.h"
15 #include "Schedule.h"
16 #include "LdvProfile.h"
17 #include "Updates.h"
18 #include "STM.h"
19 #include "Sanity.h"
20 #include "Profiling.h"
21 #if defined(mingw32_HOST_OS)
22 #include "win32/IOManager.h"
23 #endif
24
25 static void raiseAsync (Capability *cap,
26 StgTSO *tso,
27 StgClosure *exception,
28 rtsBool stop_at_atomically,
29 StgPtr stop_here);
30
31 static void removeFromQueues(Capability *cap, StgTSO *tso);
32
33 static void blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target);
34
35 static void performBlockedException (Capability *cap,
36 StgTSO *source, StgTSO *target);
37
38 /* -----------------------------------------------------------------------------
39 throwToSingleThreaded
40
41 This version of throwTo is safe to use if and only if one of the
42 following holds:
43
44 - !THREADED_RTS
45
46 - all the other threads in the system are stopped (eg. during GC).
47
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).
50
51 It doesn't cater for blocking the source thread until the exception
52 has been raised.
53 -------------------------------------------------------------------------- */
54
55 void
56 throwToSingleThreaded(Capability *cap, StgTSO *tso, StgClosure *exception)
57 {
58 throwToSingleThreaded_(cap, tso, exception, rtsFalse, NULL);
59 }
60
61 void
62 throwToSingleThreaded_(Capability *cap, StgTSO *tso, StgClosure *exception,
63 rtsBool stop_at_atomically, StgPtr stop_here)
64 {
65 // Thread already dead?
66 if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
67 return;
68 }
69
70 // Remove it from any blocking queues
71 removeFromQueues(cap,tso);
72
73 raiseAsync(cap, tso, exception, stop_at_atomically, stop_here);
74 }
75
76 void
77 suspendComputation(Capability *cap, StgTSO *tso, StgPtr stop_here)
78 {
79 // Thread already dead?
80 if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
81 return;
82 }
83
84 // Remove it from any blocking queues
85 removeFromQueues(cap,tso);
86
87 raiseAsync(cap, tso, NULL, rtsFalse, stop_here);
88 }
89
90 /* -----------------------------------------------------------------------------
91 throwTo
92
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.
98
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.
107
108 This fallback scheme works even if the target thread is complete or
109 killed: scheduleDoGC() will discover the blocked thread before the
110 target is GC'd.
111
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).
115
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
120 wherever possible.
121
122 We can promptly deliver the exception if the target thread is:
123
124 - runnable, on the same Capability as the source thread (because
125 we own the run queue and therefore the target thread).
126
127 - blocked, and we can obtain exclusive access to it. Obtaining
128 exclusive access to the thread depends on how it is blocked.
129
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.
133
134 Returns:
135
136 THROWTO_SUCCESS exception was raised, ok to continue
137
138 THROWTO_BLOCKED exception was not raised; block the source
139 thread then call throwToReleaseTarget() when
140 the source thread is properly tidied away.
141
142 -------------------------------------------------------------------------- */
143
144 nat
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)
150 {
151 StgWord status;
152
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);
158 }
159
160 debugTrace(DEBUG_sched, "throwTo: from thread %lu to thread %lu",
161 (unsigned long)source->id, (unsigned long)target->id);
162
163 #ifdef DEBUG
164 if (traceClass(DEBUG_sched)) {
165 debugTraceBegin("throwTo: target");
166 printThreadStatus(target);
167 debugTraceEnd();
168 }
169 #endif
170
171 goto check_target;
172 retry:
173 debugTrace(DEBUG_sched, "throwTo: retrying...");
174
175 check_target:
176 // Thread already dead?
177 if (target->what_next == ThreadComplete
178 || target->what_next == ThreadKilled) {
179 return THROWTO_SUCCESS;
180 }
181
182 status = target->why_blocked;
183
184 switch (status) {
185 case NotBlocked:
186 /* if status==NotBlocked, and target->cap == cap, then
187 we own this TSO and can raise the exception.
188
189 How do we establish this condition? Very carefully.
190
191 Let
192 P = (status == NotBlocked)
193 Q = (tso->cap == cap)
194
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.
197
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.
200
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
204 another capability.
205
206 Suppose we test like this:
207
208 p = P
209 q = Q
210 if (p && q) ...
211
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
215
216 Q = 0
217 P = 1
218
219 assuming arbitrary reordering, we could see this
220 interleaving:
221
222 start: P==0 && Q==1
223 P = 1
224 p = P
225 q = Q
226 Q = 0
227 if (p && q) ...
228
229 so we need a memory barrier:
230
231 p = P
232 mb()
233 q = Q
234 if (p && q) ...
235
236 this avoids the problematic case. There are other cases
237 to consider, but this is the tricky one.
238
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.
243 */
244 {
245 Capability *target_cap;
246
247 write_barrier();
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;
253 } else {
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.
258 lockTSO(target);
259
260 // Avoid race with threadStackOverflow, which may have
261 // just moved this TSO.
262 if (target->what_next == ThreadRelocated) {
263 unlockTSO(target);
264 target = target->_link;
265 goto retry;
266 }
267 blockedThrowTo(cap,source,target);
268 *out = target;
269 return THROWTO_BLOCKED;
270 }
271 }
272
273 case BlockedOnMVar:
274 {
275 /*
276 To establish ownership of this TSO, we need to acquire a
277 lock on the MVar that it is blocked on.
278 */
279 StgMVar *mvar;
280 StgInfoTable *info USED_IF_THREADS;
281
282 mvar = (StgMVar *)target->block_info.closure;
283
284 // ASSUMPTION: tso->block_info must always point to a
285 // closure. In the threaded RTS it does.
286 switch (get_itbl(mvar)->type) {
287 case MVAR_CLEAN:
288 case MVAR_DIRTY:
289 break;
290 default:
291 goto retry;
292 }
293
294 info = lockClosure((StgClosure *)mvar);
295
296 if (target->what_next == ThreadRelocated) {
297 target = target->_link;
298 unlockClosure((StgClosure *)mvar,info);
299 goto retry;
300 }
301 // we have the MVar, let's check whether the thread
302 // is still blocked on the same MVar.
303 if (target->why_blocked != BlockedOnMVar
304 || (StgMVar *)target->block_info.closure != mvar) {
305 unlockClosure((StgClosure *)mvar, info);
306 goto retry;
307 }
308
309 if ((target->flags & TSO_BLOCKEX) &&
310 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
311 lockClosure((StgClosure *)target);
312 blockedThrowTo(cap,source,target);
313 unlockClosure((StgClosure *)mvar, info);
314 *out = target;
315 return THROWTO_BLOCKED; // caller releases TSO
316 } else {
317 removeThreadFromMVarQueue(cap, mvar, target);
318 raiseAsync(cap, target, exception, rtsFalse, NULL);
319 unblockOne(cap, target);
320 unlockClosure((StgClosure *)mvar, info);
321 return THROWTO_SUCCESS;
322 }
323 }
324
325 case BlockedOnBlackHole:
326 {
327 ACQUIRE_LOCK(&sched_mutex);
328 // double checking the status after the memory barrier:
329 if (target->why_blocked != BlockedOnBlackHole) {
330 RELEASE_LOCK(&sched_mutex);
331 goto retry;
332 }
333
334 if (target->flags & TSO_BLOCKEX) {
335 lockTSO(target);
336 blockedThrowTo(cap,source,target);
337 RELEASE_LOCK(&sched_mutex);
338 *out = target;
339 return THROWTO_BLOCKED; // caller releases TSO
340 } else {
341 removeThreadFromQueue(cap, &blackhole_queue, target);
342 raiseAsync(cap, target, exception, rtsFalse, NULL);
343 unblockOne(cap, target);
344 RELEASE_LOCK(&sched_mutex);
345 return THROWTO_SUCCESS;
346 }
347 }
348
349 case BlockedOnException:
350 {
351 StgTSO *target2;
352 StgInfoTable *info;
353
354 /*
355 To obtain exclusive access to a BlockedOnException thread,
356 we must call lockClosure() on the TSO on which it is blocked.
357 Since the TSO might change underneath our feet, after we
358 call lockClosure() we must check that
359
360 (a) the closure we locked is actually a TSO
361 (b) the original thread is still BlockedOnException,
362 (c) the original thread is still blocked on the TSO we locked
363 and (d) the target thread has not been relocated.
364
365 We synchronise with threadStackOverflow() (which relocates
366 threads) using lockClosure()/unlockClosure().
367 */
368 target2 = target->block_info.tso;
369
370 info = lockClosure((StgClosure *)target2);
371 if (info != &stg_TSO_info) {
372 unlockClosure((StgClosure *)target2, info);
373 goto retry;
374 }
375 if (target->what_next == ThreadRelocated) {
376 target = target->_link;
377 unlockTSO(target2);
378 goto retry;
379 }
380 if (target2->what_next == ThreadRelocated) {
381 target->block_info.tso = target2->_link;
382 unlockTSO(target2);
383 goto retry;
384 }
385 if (target->why_blocked != BlockedOnException
386 || target->block_info.tso != target2) {
387 unlockTSO(target2);
388 goto retry;
389 }
390
391 /*
392 Now we have exclusive rights to the target TSO...
393
394 If it is blocking exceptions, add the source TSO to its
395 blocked_exceptions queue. Otherwise, raise the exception.
396 */
397 if ((target->flags & TSO_BLOCKEX) &&
398 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
399 lockTSO(target);
400 blockedThrowTo(cap,source,target);
401 unlockTSO(target2);
402 *out = target;
403 return THROWTO_BLOCKED;
404 } else {
405 removeThreadFromQueue(cap, &target2->blocked_exceptions, target);
406 raiseAsync(cap, target, exception, rtsFalse, NULL);
407 unblockOne(cap, target);
408 unlockTSO(target2);
409 return THROWTO_SUCCESS;
410 }
411 }
412
413 case BlockedOnSTM:
414 lockTSO(target);
415 // Unblocking BlockedOnSTM threads requires the TSO to be
416 // locked; see STM.c:unpark_tso().
417 if (target->why_blocked != BlockedOnSTM) {
418 goto retry;
419 }
420 if ((target->flags & TSO_BLOCKEX) &&
421 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
422 blockedThrowTo(cap,source,target);
423 *out = target;
424 return THROWTO_BLOCKED;
425 } else {
426 raiseAsync(cap, target, exception, rtsFalse, NULL);
427 unblockOne(cap, target);
428 unlockTSO(target);
429 return THROWTO_SUCCESS;
430 }
431
432 case BlockedOnCCall:
433 case BlockedOnCCall_NoUnblockExc:
434 // I don't think it's possible to acquire ownership of a
435 // BlockedOnCCall thread. We just assume that the target
436 // thread is blocking exceptions, and block on its
437 // blocked_exception queue.
438 lockTSO(target);
439 blockedThrowTo(cap,source,target);
440 *out = target;
441 return THROWTO_BLOCKED;
442
443 #ifndef THREADEDED_RTS
444 case BlockedOnRead:
445 case BlockedOnWrite:
446 case BlockedOnDelay:
447 #if defined(mingw32_HOST_OS)
448 case BlockedOnDoProc:
449 #endif
450 if ((target->flags & TSO_BLOCKEX) &&
451 ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
452 blockedThrowTo(cap,source,target);
453 return THROWTO_BLOCKED;
454 } else {
455 removeFromQueues(cap,target);
456 raiseAsync(cap, target, exception, rtsFalse, NULL);
457 return THROWTO_SUCCESS;
458 }
459 #endif
460
461 default:
462 barf("throwTo: unrecognised why_blocked value");
463 }
464 barf("throwTo");
465 }
466
467 // Block a TSO on another TSO's blocked_exceptions queue.
468 // Precondition: we hold an exclusive lock on the target TSO (this is
469 // complex to achieve as there's no single lock on a TSO; see
470 // throwTo()).
471 static void
472 blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target)
473 {
474 debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
475 setTSOLink(cap, source, target->blocked_exceptions);
476 target->blocked_exceptions = source;
477 dirty_TSO(cap,target); // we modified the blocked_exceptions queue
478
479 source->block_info.tso = target;
480 write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
481 source->why_blocked = BlockedOnException;
482 }
483
484
485 #ifdef THREADED_RTS
486 void
487 throwToReleaseTarget (void *tso)
488 {
489 unlockTSO((StgTSO *)tso);
490 }
491 #endif
492
493 /* -----------------------------------------------------------------------------
494 Waking up threads blocked in throwTo
495
496 There are two ways to do this: maybePerformBlockedException() will
497 perform the throwTo() for the thread at the head of the queue
498 immediately, and leave the other threads on the queue.
499 maybePerformBlockedException() also checks the TSO_BLOCKEX flag
500 before raising an exception.
501
502 awakenBlockedExceptionQueue() will wake up all the threads in the
503 queue, but not perform any throwTo() immediately. This might be
504 more appropriate when the target thread is the one actually running
505 (see Exception.cmm).
506
507 Returns: non-zero if an exception was raised, zero otherwise.
508 -------------------------------------------------------------------------- */
509
510 int
511 maybePerformBlockedException (Capability *cap, StgTSO *tso)
512 {
513 StgTSO *source;
514
515 if (tso->blocked_exceptions != END_TSO_QUEUE &&
516 (tso->flags & TSO_BLOCKEX) != 0) {
517 debugTrace(DEBUG_sched, "throwTo: thread %lu has blocked exceptions but is inside block", (unsigned long)tso->id);
518 }
519
520 if (tso->blocked_exceptions != END_TSO_QUEUE
521 && ((tso->flags & TSO_BLOCKEX) == 0
522 || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) {
523
524 // Lock the TSO, this gives us exclusive access to the queue
525 lockTSO(tso);
526
527 // Check the queue again; it might have changed before we
528 // locked it.
529 if (tso->blocked_exceptions == END_TSO_QUEUE) {
530 unlockTSO(tso);
531 return 0;
532 }
533
534 // We unblock just the first thread on the queue, and perform
535 // its throw immediately.
536 source = tso->blocked_exceptions;
537 performBlockedException(cap, source, tso);
538 tso->blocked_exceptions = unblockOne_(cap, source,
539 rtsFalse/*no migrate*/);
540 unlockTSO(tso);
541 return 1;
542 }
543 return 0;
544 }
545
546 void
547 awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso)
548 {
549 if (tso->blocked_exceptions != END_TSO_QUEUE) {
550 lockTSO(tso);
551 awakenBlockedQueue(cap, tso->blocked_exceptions);
552 tso->blocked_exceptions = END_TSO_QUEUE;
553 unlockTSO(tso);
554 }
555 }
556
557 static void
558 performBlockedException (Capability *cap, StgTSO *source, StgTSO *target)
559 {
560 StgClosure *exception;
561
562 ASSERT(source->why_blocked == BlockedOnException);
563 ASSERT(source->block_info.tso->id == target->id);
564 ASSERT(source->sp[0] == (StgWord)&stg_block_throwto_info);
565 ASSERT(((StgTSO *)source->sp[1])->id == target->id);
566 // check ids not pointers, because the thread might be relocated
567
568 exception = (StgClosure *)source->sp[2];
569 throwToSingleThreaded(cap, target, exception);
570 source->sp += 3;
571 }
572
573 /* -----------------------------------------------------------------------------
574 Remove a thread from blocking queues.
575
576 This is for use when we raise an exception in another thread, which
577 may be blocked.
578 This has nothing to do with the UnblockThread event in GranSim. -- HWL
579 -------------------------------------------------------------------------- */
580
581 #if defined(GRAN) || defined(PARALLEL_HASKELL)
582 /*
583 NB: only the type of the blocking queue is different in GranSim and GUM
584 the operations on the queue-elements are the same
585 long live polymorphism!
586
587 Locks: sched_mutex is held upon entry and exit.
588
589 */
590 static void
591 removeFromQueues(Capability *cap, StgTSO *tso)
592 {
593 StgBlockingQueueElement *t, **last;
594
595 switch (tso->why_blocked) {
596
597 case NotBlocked:
598 return; /* not blocked */
599
600 case BlockedOnSTM:
601 // Be careful: nothing to do here! We tell the scheduler that the thread
602 // is runnable and we leave it to the stack-walking code to abort the
603 // transaction while unwinding the stack. We should perhaps have a debugging
604 // test to make sure that this really happens and that the 'zombie' transaction
605 // does not get committed.
606 goto done;
607
608 case BlockedOnMVar:
609 ASSERT(get_itbl(tso->block_info.closure)->type == MVAR);
610 {
611 StgBlockingQueueElement *last_tso = END_BQ_QUEUE;
612 StgMVar *mvar = (StgMVar *)(tso->block_info.closure);
613
614 last = (StgBlockingQueueElement **)&mvar->head;
615 for (t = (StgBlockingQueueElement *)mvar->head;
616 t != END_BQ_QUEUE;
617 last = &t->link, last_tso = t, t = t->link) {
618 if (t == (StgBlockingQueueElement *)tso) {
619 *last = (StgBlockingQueueElement *)tso->link;
620 if (mvar->tail == tso) {
621 mvar->tail = (StgTSO *)last_tso;
622 }
623 goto done;
624 }
625 }
626 barf("removeFromQueues (MVAR): TSO not found");
627 }
628
629 case BlockedOnBlackHole:
630 ASSERT(get_itbl(tso->block_info.closure)->type == BLACKHOLE_BQ);
631 {
632 StgBlockingQueue *bq = (StgBlockingQueue *)(tso->block_info.closure);
633
634 last = &bq->blocking_queue;
635 for (t = bq->blocking_queue;
636 t != END_BQ_QUEUE;
637 last = &t->link, t = t->link) {
638 if (t == (StgBlockingQueueElement *)tso) {
639 *last = (StgBlockingQueueElement *)tso->link;
640 goto done;
641 }
642 }
643 barf("removeFromQueues (BLACKHOLE): TSO not found");
644 }
645
646 case BlockedOnException:
647 {
648 StgTSO *target = tso->block_info.tso;
649
650 ASSERT(get_itbl(target)->type == TSO);
651
652 while (target->what_next == ThreadRelocated) {
653 target = target2->link;
654 ASSERT(get_itbl(target)->type == TSO);
655 }
656
657 last = (StgBlockingQueueElement **)&target->blocked_exceptions;
658 for (t = (StgBlockingQueueElement *)target->blocked_exceptions;
659 t != END_BQ_QUEUE;
660 last = &t->link, t = t->link) {
661 ASSERT(get_itbl(t)->type == TSO);
662 if (t == (StgBlockingQueueElement *)tso) {
663 *last = (StgBlockingQueueElement *)tso->link;
664 goto done;
665 }
666 }
667 barf("removeFromQueues (Exception): TSO not found");
668 }
669
670 case BlockedOnRead:
671 case BlockedOnWrite:
672 #if defined(mingw32_HOST_OS)
673 case BlockedOnDoProc:
674 #endif
675 {
676 /* take TSO off blocked_queue */
677 StgBlockingQueueElement *prev = NULL;
678 for (t = (StgBlockingQueueElement *)blocked_queue_hd; t != END_BQ_QUEUE;
679 prev = t, t = t->link) {
680 if (t == (StgBlockingQueueElement *)tso) {
681 if (prev == NULL) {
682 blocked_queue_hd = (StgTSO *)t->link;
683 if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
684 blocked_queue_tl = END_TSO_QUEUE;
685 }
686 } else {
687 prev->link = t->link;
688 if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
689 blocked_queue_tl = (StgTSO *)prev;
690 }
691 }
692 #if defined(mingw32_HOST_OS)
693 /* (Cooperatively) signal that the worker thread should abort
694 * the request.
695 */
696 abandonWorkRequest(tso->block_info.async_result->reqID);
697 #endif
698 goto done;
699 }
700 }
701 barf("removeFromQueues (I/O): TSO not found");
702 }
703
704 case BlockedOnDelay:
705 {
706 /* take TSO off sleeping_queue */
707 StgBlockingQueueElement *prev = NULL;
708 for (t = (StgBlockingQueueElement *)sleeping_queue; t != END_BQ_QUEUE;
709 prev = t, t = t->link) {
710 if (t == (StgBlockingQueueElement *)tso) {
711 if (prev == NULL) {
712 sleeping_queue = (StgTSO *)t->link;
713 } else {
714 prev->link = t->link;
715 }
716 goto done;
717 }
718 }
719 barf("removeFromQueues (delay): TSO not found");
720 }
721
722 default:
723 barf("removeFromQueues: %d", tso->why_blocked);
724 }
725
726 done:
727 tso->link = END_TSO_QUEUE;
728 tso->why_blocked = NotBlocked;
729 tso->block_info.closure = NULL;
730 pushOnRunQueue(cap,tso);
731 }
732 #else
733 static void
734 removeFromQueues(Capability *cap, StgTSO *tso)
735 {
736 switch (tso->why_blocked) {
737
738 case NotBlocked:
739 return;
740
741 case BlockedOnSTM:
742 // Be careful: nothing to do here! We tell the scheduler that the
743 // thread is runnable and we leave it to the stack-walking code to
744 // abort the transaction while unwinding the stack. We should
745 // perhaps have a debugging test to make sure that this really
746 // happens and that the 'zombie' transaction does not get
747 // committed.
748 goto done;
749
750 case BlockedOnMVar:
751 removeThreadFromMVarQueue(cap, (StgMVar *)tso->block_info.closure, tso);
752 goto done;
753
754 case BlockedOnBlackHole:
755 removeThreadFromQueue(cap, &blackhole_queue, tso);
756 goto done;
757
758 case BlockedOnException:
759 {
760 StgTSO *target = tso->block_info.tso;
761
762 // NO: when called by threadPaused(), we probably have this
763 // TSO already locked (WHITEHOLEd) because we just placed
764 // ourselves on its queue.
765 // ASSERT(get_itbl(target)->type == TSO);
766
767 while (target->what_next == ThreadRelocated) {
768 target = target->_link;
769 }
770
771 removeThreadFromQueue(cap, &target->blocked_exceptions, tso);
772 goto done;
773 }
774
775 #if !defined(THREADED_RTS)
776 case BlockedOnRead:
777 case BlockedOnWrite:
778 #if defined(mingw32_HOST_OS)
779 case BlockedOnDoProc:
780 #endif
781 removeThreadFromDeQueue(cap, &blocked_queue_hd, &blocked_queue_tl, tso);
782 #if defined(mingw32_HOST_OS)
783 /* (Cooperatively) signal that the worker thread should abort
784 * the request.
785 */
786 abandonWorkRequest(tso->block_info.async_result->reqID);
787 #endif
788 goto done;
789
790 case BlockedOnDelay:
791 removeThreadFromQueue(cap, &sleeping_queue, tso);
792 goto done;
793 #endif
794
795 default:
796 barf("removeFromQueues: %d", tso->why_blocked);
797 }
798
799 done:
800 tso->_link = END_TSO_QUEUE; // no write barrier reqd
801 tso->why_blocked = NotBlocked;
802 tso->block_info.closure = NULL;
803 appendToRunQueue(cap,tso);
804
805 // We might have just migrated this TSO to our Capability:
806 if (tso->bound) {
807 tso->bound->cap = cap;
808 }
809 tso->cap = cap;
810 }
811 #endif
812
813 /* -----------------------------------------------------------------------------
814 * raiseAsync()
815 *
816 * The following function implements the magic for raising an
817 * asynchronous exception in an existing thread.
818 *
819 * We first remove the thread from any queue on which it might be
820 * blocked. The possible blockages are MVARs and BLACKHOLE_BQs.
821 *
822 * We strip the stack down to the innermost CATCH_FRAME, building
823 * thunks in the heap for all the active computations, so they can
824 * be restarted if necessary. When we reach a CATCH_FRAME, we build
825 * an application of the handler to the exception, and push it on
826 * the top of the stack.
827 *
828 * How exactly do we save all the active computations? We create an
829 * AP_STACK for every UpdateFrame on the stack. Entering one of these
830 * AP_STACKs pushes everything from the corresponding update frame
831 * upwards onto the stack. (Actually, it pushes everything up to the
832 * next update frame plus a pointer to the next AP_STACK object.
833 * Entering the next AP_STACK object pushes more onto the stack until we
834 * reach the last AP_STACK object - at which point the stack should look
835 * exactly as it did when we killed the TSO and we can continue
836 * execution by entering the closure on top of the stack.
837 *
838 * We can also kill a thread entirely - this happens if either (a) the
839 * exception passed to raiseAsync is NULL, or (b) there's no
840 * CATCH_FRAME on the stack. In either case, we strip the entire
841 * stack and replace the thread with a zombie.
842 *
843 * ToDo: in THREADED_RTS mode, this function is only safe if either
844 * (a) we hold all the Capabilities (eg. in GC, or if there is only
845 * one Capability), or (b) we own the Capability that the TSO is
846 * currently blocked on or on the run queue of.
847 *
848 * -------------------------------------------------------------------------- */
849
850 static void
851 raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
852 rtsBool stop_at_atomically, StgPtr stop_here)
853 {
854 StgRetInfoTable *info;
855 StgPtr sp, frame;
856 nat i;
857
858 debugTrace(DEBUG_sched,
859 "raising exception in thread %ld.", (long)tso->id);
860
861 #if defined(PROFILING)
862 /*
863 * Debugging tool: on raising an exception, show where we are.
864 * See also Exception.cmm:raisezh_fast.
865 * This wasn't done for asynchronous exceptions originally; see #1450
866 */
867 if (RtsFlags.ProfFlags.showCCSOnException)
868 {
869 fprintCCS_stderr(tso->prof.CCCS);
870 }
871 #endif
872
873 // mark it dirty; we're about to change its stack.
874 dirty_TSO(cap, tso);
875
876 sp = tso->sp;
877
878 // ASSUMES: the thread is not already complete or dead. Upper
879 // layers should deal with that.
880 ASSERT(tso->what_next != ThreadComplete && tso->what_next != ThreadKilled);
881
882 // The stack freezing code assumes there's a closure pointer on
883 // the top of the stack, so we have to arrange that this is the case...
884 //
885 if (sp[0] == (W_)&stg_enter_info) {
886 sp++;
887 } else {
888 sp--;
889 sp[0] = (W_)&stg_dummy_ret_closure;
890 }
891
892 frame = sp + 1;
893 while (stop_here == NULL || frame < stop_here) {
894
895 // 1. Let the top of the stack be the "current closure"
896 //
897 // 2. Walk up the stack until we find either an UPDATE_FRAME or a
898 // CATCH_FRAME.
899 //
900 // 3. If it's an UPDATE_FRAME, then make an AP_STACK containing the
901 // current closure applied to the chunk of stack up to (but not
902 // including) the update frame. This closure becomes the "current
903 // closure". Go back to step 2.
904 //
905 // 4. If it's a CATCH_FRAME, then leave the exception handler on
906 // top of the stack applied to the exception.
907 //
908 // 5. If it's a STOP_FRAME, then kill the thread.
909 //
910 // NB: if we pass an ATOMICALLY_FRAME then abort the associated
911 // transaction
912
913 info = get_ret_itbl((StgClosure *)frame);
914
915 switch (info->i.type) {
916
917 case UPDATE_FRAME:
918 {
919 StgAP_STACK * ap;
920 nat words;
921
922 // First build an AP_STACK consisting of the stack chunk above the
923 // current update frame, with the top word on the stack as the
924 // fun field.
925 //
926 words = frame - sp - 1;
927 ap = (StgAP_STACK *)allocateLocal(cap,AP_STACK_sizeW(words));
928
929 ap->size = words;
930 ap->fun = (StgClosure *)sp[0];
931 sp++;
932 for(i=0; i < (nat)words; ++i) {
933 ap->payload[i] = (StgClosure *)*sp++;
934 }
935
936 SET_HDR(ap,&stg_AP_STACK_info,
937 ((StgClosure *)frame)->header.prof.ccs /* ToDo */);
938 TICK_ALLOC_UP_THK(words+1,0);
939
940 //IF_DEBUG(scheduler,
941 // debugBelch("sched: Updating ");
942 // printPtr((P_)((StgUpdateFrame *)frame)->updatee);
943 // debugBelch(" with ");
944 // printObj((StgClosure *)ap);
945 // );
946
947 // Perform the update
948 // TODO: this may waste some work, if the thunk has
949 // already been updated by another thread.
950 UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
951 (StgClosure *)ap);
952
953 sp += sizeofW(StgUpdateFrame) - 1;
954 sp[0] = (W_)ap; // push onto stack
955 frame = sp + 1;
956 continue; //no need to bump frame
957 }
958
959 case STOP_FRAME:
960 {
961 // We've stripped the entire stack, the thread is now dead.
962 tso->what_next = ThreadKilled;
963 tso->sp = frame + sizeofW(StgStopFrame);
964 return;
965 }
966
967 case CATCH_FRAME:
968 // If we find a CATCH_FRAME, and we've got an exception to raise,
969 // then build the THUNK raise(exception), and leave it on
970 // top of the CATCH_FRAME ready to enter.
971 //
972 {
973 #ifdef PROFILING
974 StgCatchFrame *cf = (StgCatchFrame *)frame;
975 #endif
976 StgThunk *raise;
977
978 if (exception == NULL) break;
979
980 // we've got an exception to raise, so let's pass it to the
981 // handler in this frame.
982 //
983 raise = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
984 TICK_ALLOC_SE_THK(1,0);
985 SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
986 raise->payload[0] = exception;
987
988 // throw away the stack from Sp up to the CATCH_FRAME.
989 //
990 sp = frame - 1;
991
992 /* Ensure that async excpetions are blocked now, so we don't get
993 * a surprise exception before we get around to executing the
994 * handler.
995 */
996 tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
997
998 /* Put the newly-built THUNK on top of the stack, ready to execute
999 * when the thread restarts.
1000 */
1001 sp[0] = (W_)raise;
1002 sp[-1] = (W_)&stg_enter_info;
1003 tso->sp = sp-1;
1004 tso->what_next = ThreadRunGHC;
1005 IF_DEBUG(sanity, checkTSO(tso));
1006 return;
1007 }
1008
1009 case ATOMICALLY_FRAME:
1010 if (stop_at_atomically) {
1011 ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
1012 stmCondemnTransaction(cap, tso -> trec);
1013 #ifdef REG_R1
1014 tso->sp = frame;
1015 #else
1016 // R1 is not a register: the return convention for IO in
1017 // this case puts the return value on the stack, so we
1018 // need to set up the stack to return to the atomically
1019 // frame properly...
1020 tso->sp = frame - 2;
1021 tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
1022 tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
1023 #endif
1024 tso->what_next = ThreadRunGHC;
1025 return;
1026 }
1027 // Not stop_at_atomically... fall through and abort the
1028 // transaction.
1029
1030 case CATCH_RETRY_FRAME:
1031 // IF we find an ATOMICALLY_FRAME then we abort the
1032 // current transaction and propagate the exception. In
1033 // this case (unlike ordinary exceptions) we do not care
1034 // whether the transaction is valid or not because its
1035 // possible validity cannot have caused the exception
1036 // and will not be visible after the abort.
1037
1038 {
1039 StgTRecHeader *trec = tso -> trec;
1040 StgTRecHeader *outer = stmGetEnclosingTRec(trec);
1041 debugTrace(DEBUG_stm,
1042 "found atomically block delivering async exception");
1043 stmAbortTransaction(cap, trec);
1044 stmFreeAbortedTRec(cap, trec);
1045 tso -> trec = outer;
1046 break;
1047 };
1048
1049 default:
1050 break;
1051 }
1052
1053 // move on to the next stack frame
1054 frame += stack_frame_sizeW((StgClosure *)frame);
1055 }
1056
1057 // if we got here, then we stopped at stop_here
1058 ASSERT(stop_here != NULL);
1059 }
1060
1061