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