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         switch (get_itbl(mvar)->type) {
 286         case MVAR_CLEAN:
 287         case MVAR_DIRTY:
 288             break;
 289         default:
 290             goto retry;
 291         }
 292
 293         info = lockClosure((StgClosure *)mvar);
 294
 295         if (target->what_next == ThreadRelocated) {
 296             target = target->link;
 297             unlockClosure((StgClosure *)mvar,info);
 298             goto retry;
 299         }
 300         // we have the MVar, let's check whether the thread
 301         // is still blocked on the same MVar.
 302         if (target->why_blocked != BlockedOnMVar
 303             || (StgMVar *)target->block_info.closure != mvar) {
 304             unlockClosure((StgClosure *)mvar, info);
 305             goto retry;
 306         }
 307
 308         if ((target->flags & TSO_BLOCKEX) &&
 309             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 310             lockClosure((StgClosure *)target);
 311             blockedThrowTo(source,target);
 312             unlockClosure((StgClosure *)mvar, info);
 313             *out = target;
 314             return THROWTO_BLOCKED; // caller releases TSO
 315         } else {
 316             removeThreadFromMVarQueue(mvar, target);
 317             raiseAsync(cap, target, exception, rtsFalse, NULL);
 318             unblockOne(cap, target);
 319             unlockClosure((StgClosure *)mvar, info);
 320             return THROWTO_SUCCESS;
 321         }
 322     }
 323
 324     case BlockedOnBlackHole:
 325     {
 326         ACQUIRE_LOCK(&sched_mutex);
 327         // double checking the status after the memory barrier:
 328         if (target->why_blocked != BlockedOnBlackHole) {
 329             RELEASE_LOCK(&sched_mutex);
 330             goto retry;
 331         }
 332
 333         if (target->flags & TSO_BLOCKEX) {
 334             lockTSO(target);
 335             blockedThrowTo(source,target);
 336             RELEASE_LOCK(&sched_mutex);
 337             *out = target;
 338             return THROWTO_BLOCKED; // caller releases TSO
 339         } else {
 340             removeThreadFromQueue(&blackhole_queue, target);
 341             raiseAsync(cap, target, exception, rtsFalse, NULL);
 342             unblockOne(cap, target);
 343             RELEASE_LOCK(&sched_mutex);
 344             return THROWTO_SUCCESS;
 345         }
 346     }
 347
 348     case BlockedOnException:
 349     {
 350         StgTSO *target2;
 351         StgInfoTable *info;
 352
 353         /*
 354           To obtain exclusive access to a BlockedOnException thread,
 355           we must call lockClosure() on the TSO on which it is blocked.
 356           Since the TSO might change underneath our feet, after we
 357           call lockClosure() we must check that
 358
 359              (a) the closure we locked is actually a TSO
 360              (b) the original thread is still  BlockedOnException,
 361              (c) the original thread is still blocked on the TSO we locked
 362              and (d) the target thread has not been relocated.
 363
 364           We synchronise with threadStackOverflow() (which relocates
 365           threads) using lockClosure()/unlockClosure().
 366         */
 367         target2 = target->block_info.tso;
 368
 369         info = lockClosure((StgClosure *)target2);
 370         if (info != &stg_TSO_info) {
 371             unlockClosure((StgClosure *)target2, info);
 372             goto retry;
 373         }
 374         if (target->what_next == ThreadRelocated) {
 375             target = target->link;
 376             unlockTSO(target2);
 377             goto retry;
 378         }
 379         if (target2->what_next == ThreadRelocated) {
 380             target->block_info.tso = target2->link;
 381             unlockTSO(target2);
 382             goto retry;
 383         }
 384         if (target->why_blocked != BlockedOnException
 385             || target->block_info.tso != target2) {
 386             unlockTSO(target2);
 387             goto retry;
 388         }
 389
 390         /*
 391            Now we have exclusive rights to the target TSO...
 392
 393            If it is blocking exceptions, add the source TSO to its
 394            blocked_exceptions queue.  Otherwise, raise the exception.
 395         */
 396         if ((target->flags & TSO_BLOCKEX) &&
 397             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 398             lockTSO(target);
 399             blockedThrowTo(source,target);
 400             unlockTSO(target2);
 401             *out = target;
 402             return THROWTO_BLOCKED;
 403         } else {
 404             removeThreadFromQueue(&target2->blocked_exceptions, target);
 405             raiseAsync(cap, target, exception, rtsFalse, NULL);
 406             unblockOne(cap, target);
 407             unlockTSO(target2);
 408             return THROWTO_SUCCESS;
 409         }
 410     }
 411
 412     case BlockedOnSTM:
 413         lockTSO(target);
 414         // Unblocking BlockedOnSTM threads requires the TSO to be
 415         // locked; see STM.c:unpark_tso().
 416         if (target->why_blocked != BlockedOnSTM) {
 417             goto retry;
 418         }
 419         if ((target->flags & TSO_BLOCKEX) &&
 420             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 421             blockedThrowTo(source,target);
 422             *out = target;
 423             return THROWTO_BLOCKED;
 424         } else {
 425             raiseAsync(cap, target, exception, rtsFalse, NULL);
 426             unblockOne(cap, target);
 427             unlockTSO(target);
 428             return THROWTO_SUCCESS;
 429         }
 430
 431     case BlockedOnCCall:
 432     case BlockedOnCCall_NoUnblockExc:
 433         // I don't think it's possible to acquire ownership of a
 434         // BlockedOnCCall thread.  We just assume that the target
 435         // thread is blocking exceptions, and block on its
 436         // blocked_exception queue.
 437         lockTSO(target);
 438         blockedThrowTo(source,target);
 439         *out = target;
 440         return THROWTO_BLOCKED;
 441
 442 #ifndef THREADEDED_RTS
 443     case BlockedOnRead:
 444     case BlockedOnWrite:
 445     case BlockedOnDelay:
 446 #if defined(mingw32_HOST_OS)
 447     case BlockedOnDoProc:
 448 #endif
 449         if ((target->flags & TSO_BLOCKEX) &&
 450             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 451             blockedThrowTo(source,target);
 452             return THROWTO_BLOCKED;
 453         } else {
 454             removeFromQueues(cap,target);
 455             raiseAsync(cap, target, exception, rtsFalse, NULL);
 456             return THROWTO_SUCCESS;
 457         }
 458 #endif
 459
 460     default:
 461         barf("throwTo: unrecognised why_blocked value");
 462     }
 463     barf("throwTo");
 464 }
 465
 466 // Block a TSO on another TSO's blocked_exceptions queue.
 467 // Precondition: we hold an exclusive lock on the target TSO (this is
 468 // complex to achieve as there's no single lock on a TSO; see
 469 // throwTo()).
 470 static void
 471 blockedThrowTo (StgTSO *source, StgTSO *target)
 472 {
 473     debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
 474     source->link = target->blocked_exceptions;
 475     target->blocked_exceptions = source;
 476     dirtyTSO(target); // we modified the blocked_exceptions queue
 477
 478     source->block_info.tso = target;
 479     write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
 480     source->why_blocked = BlockedOnException;
 481 }
 482
 483
 484 #ifdef THREADED_RTS
 485 void
 486 throwToReleaseTarget (void *tso)
 487 {
 488     unlockTSO((StgTSO *)tso);
 489 }
 490 #endif
 491
 492 /* -----------------------------------------------------------------------------
 493    Waking up threads blocked in throwTo
 494
 495    There are two ways to do this: maybePerformBlockedException() will
 496    perform the throwTo() for the thread at the head of the queue
 497    immediately, and leave the other threads on the queue.
 498    maybePerformBlockedException() also checks the TSO_BLOCKEX flag
 499    before raising an exception.
 500
 501    awakenBlockedExceptionQueue() will wake up all the threads in the
 502    queue, but not perform any throwTo() immediately.  This might be
 503    more appropriate when the target thread is the one actually running
 504    (see Exception.cmm).
 505
 506    Returns: non-zero if an exception was raised, zero otherwise.
 507    -------------------------------------------------------------------------- */
 508
 509 int
 510 maybePerformBlockedException (Capability *cap, StgTSO *tso)
 511 {
 512     StgTSO *source;
 513
 514     if (tso->blocked_exceptions != END_TSO_QUEUE
 515         && ((tso->flags & TSO_BLOCKEX) == 0
 516             || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) {
 517
 518         // Lock the TSO, this gives us exclusive access to the queue
 519         lockTSO(tso);
 520
 521         // Check the queue again; it might have changed before we
 522         // locked it.
 523         if (tso->blocked_exceptions == END_TSO_QUEUE) {
 524             unlockTSO(tso);
 525             return 0;
 526         }
 527
 528         // We unblock just the first thread on the queue, and perform
 529         // its throw immediately.
 530         source = tso->blocked_exceptions;
 531         performBlockedException(cap, source, tso);
 532         tso->blocked_exceptions = unblockOne_(cap, source,
 533                                               rtsFalse/*no migrate*/);
 534         unlockTSO(tso);
 535         return 1;
 536     }
 537     return 0;
 538 }
 539
 540 void
 541 awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso)
 542 {
 543     if (tso->blocked_exceptions != END_TSO_QUEUE) {
 544         lockTSO(tso);
 545         awakenBlockedQueue(cap, tso->blocked_exceptions);
 546         tso->blocked_exceptions = END_TSO_QUEUE;
 547         unlockTSO(tso);
 548     }
 549 }
 550
 551 static void
 552 performBlockedException (Capability *cap, StgTSO *source, StgTSO *target)
 553 {
 554     StgClosure *exception;
 555
 556     ASSERT(source->why_blocked == BlockedOnException);
 557     ASSERT(source->block_info.tso->id == target->id);
 558     ASSERT(source->sp[0] == (StgWord)&stg_block_throwto_info);
 559     ASSERT(((StgTSO *)source->sp[1])->id == target->id);
 560     // check ids not pointers, because the thread might be relocated
 561
 562     exception = (StgClosure *)source->sp[2];
 563     throwToSingleThreaded(cap, target, exception);
 564     source->sp += 3;
 565 }
 566
 567 /* -----------------------------------------------------------------------------
 568    Remove a thread from blocking queues.
 569
 570    This is for use when we raise an exception in another thread, which
 571    may be blocked.
 572    This has nothing to do with the UnblockThread event in GranSim. -- HWL
 573    -------------------------------------------------------------------------- */
 574
 575 #if defined(GRAN) || defined(PARALLEL_HASKELL)
 576 /*
 577   NB: only the type of the blocking queue is different in GranSim and GUM
 578       the operations on the queue-elements are the same
 579       long live polymorphism!
 580
 581   Locks: sched_mutex is held upon entry and exit.
 582
 583 */
 584 static void
 585 removeFromQueues(Capability *cap, StgTSO *tso)
 586 {
 587   StgBlockingQueueElement *t, **last;
 588
 589   switch (tso->why_blocked) {
 590
 591   case NotBlocked:
 592     return;  /* not blocked */
 593
 594   case BlockedOnSTM:
 595     // Be careful: nothing to do here!  We tell the scheduler that the thread
 596     // is runnable and we leave it to the stack-walking code to abort the
 597     // transaction while unwinding the stack.  We should perhaps have a debugging
 598     // test to make sure that this really happens and that the 'zombie' transaction
 599     // does not get committed.
 600     goto done;
 601
 602   case BlockedOnMVar:
 603     ASSERT(get_itbl(tso->block_info.closure)->type == MVAR);
 604     {
 605       StgBlockingQueueElement *last_tso = END_BQ_QUEUE;
 606       StgMVar *mvar = (StgMVar *)(tso->block_info.closure);
 607
 608       last = (StgBlockingQueueElement **)&mvar->head;
 609       for (t = (StgBlockingQueueElement *)mvar->head;
 610            t != END_BQ_QUEUE;
 611            last = &t->link, last_tso = t, t = t->link) {
 612         if (t == (StgBlockingQueueElement *)tso) {
 613           *last = (StgBlockingQueueElement *)tso->link;
 614           if (mvar->tail == tso) {
 615             mvar->tail = (StgTSO *)last_tso;
 616           }
 617           goto done;
 618         }
 619       }
 620       barf("removeFromQueues (MVAR): TSO not found");
 621     }
 622
 623   case BlockedOnBlackHole:
 624     ASSERT(get_itbl(tso->block_info.closure)->type == BLACKHOLE_BQ);
 625     {
 626       StgBlockingQueue *bq = (StgBlockingQueue *)(tso->block_info.closure);
 627
 628       last = &bq->blocking_queue;
 629       for (t = bq->blocking_queue;
 630            t != END_BQ_QUEUE;
 631            last = &t->link, t = t->link) {
 632         if (t == (StgBlockingQueueElement *)tso) {
 633           *last = (StgBlockingQueueElement *)tso->link;
 634           goto done;
 635         }
 636       }
 637       barf("removeFromQueues (BLACKHOLE): TSO not found");
 638     }
 639
 640   case BlockedOnException:
 641     {
 642       StgTSO *target  = tso->block_info.tso;
 643
 644       ASSERT(get_itbl(target)->type == TSO);
 645
 646       while (target->what_next == ThreadRelocated) {
 647           target = target2->link;
 648           ASSERT(get_itbl(target)->type == TSO);
 649       }
 650
 651       last = (StgBlockingQueueElement **)&target->blocked_exceptions;
 652       for (t = (StgBlockingQueueElement *)target->blocked_exceptions;
 653            t != END_BQ_QUEUE;
 654            last = &t->link, t = t->link) {
 655         ASSERT(get_itbl(t)->type == TSO);
 656         if (t == (StgBlockingQueueElement *)tso) {
 657           *last = (StgBlockingQueueElement *)tso->link;
 658           goto done;
 659         }
 660       }
 661       barf("removeFromQueues (Exception): TSO not found");
 662     }
 663
 664   case BlockedOnRead:
 665   case BlockedOnWrite:
 666 #if defined(mingw32_HOST_OS)
 667   case BlockedOnDoProc:
 668 #endif
 669     {
 670       /* take TSO off blocked_queue */
 671       StgBlockingQueueElement *prev = NULL;
 672       for (t = (StgBlockingQueueElement *)blocked_queue_hd; t != END_BQ_QUEUE;
 673            prev = t, t = t->link) {
 674         if (t == (StgBlockingQueueElement *)tso) {
 675           if (prev == NULL) {
 676             blocked_queue_hd = (StgTSO *)t->link;
 677             if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
 678               blocked_queue_tl = END_TSO_QUEUE;
 679             }
 680           } else {
 681             prev->link = t->link;
 682             if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
 683               blocked_queue_tl = (StgTSO *)prev;
 684             }
 685           }
 686 #if defined(mingw32_HOST_OS)
 687           /* (Cooperatively) signal that the worker thread should abort
 688            * the request.
 689            */
 690           abandonWorkRequest(tso->block_info.async_result->reqID);
 691 #endif
 692           goto done;
 693         }
 694       }
 695       barf("removeFromQueues (I/O): TSO not found");
 696     }
 697
 698   case BlockedOnDelay:
 699     {
 700       /* take TSO off sleeping_queue */
 701       StgBlockingQueueElement *prev = NULL;
 702       for (t = (StgBlockingQueueElement *)sleeping_queue; t != END_BQ_QUEUE;
 703            prev = t, t = t->link) {
 704         if (t == (StgBlockingQueueElement *)tso) {
 705           if (prev == NULL) {
 706             sleeping_queue = (StgTSO *)t->link;
 707           } else {
 708             prev->link = t->link;
 709           }
 710           goto done;
 711         }
 712       }
 713       barf("removeFromQueues (delay): TSO not found");
 714     }
 715
 716   default:
 717     barf("removeFromQueues");
 718   }
 719
 720  done:
 721   tso->link = END_TSO_QUEUE;
 722   tso->why_blocked = NotBlocked;
 723   tso->block_info.closure = NULL;
 724   pushOnRunQueue(cap,tso);
 725 }
 726 #else
 727 static void
 728 removeFromQueues(Capability *cap, StgTSO *tso)
 729 {
 730   switch (tso->why_blocked) {
 731
 732   case NotBlocked:
 733       return;
 734
 735   case BlockedOnSTM:
 736     // Be careful: nothing to do here!  We tell the scheduler that the
 737     // thread is runnable and we leave it to the stack-walking code to
 738     // abort the transaction while unwinding the stack.  We should
 739     // perhaps have a debugging test to make sure that this really
 740     // happens and that the 'zombie' transaction does not get
 741     // committed.
 742     goto done;
 743
 744   case BlockedOnMVar:
 745       removeThreadFromMVarQueue((StgMVar *)tso->block_info.closure, tso);
 746       goto done;
 747
 748   case BlockedOnBlackHole:
 749       removeThreadFromQueue(&blackhole_queue, tso);
 750       goto done;
 751
 752   case BlockedOnException:
 753     {
 754       StgTSO *target  = tso->block_info.tso;
 755
 756       // NO: when called by threadPaused(), we probably have this
 757       // TSO already locked (WHITEHOLEd) because we just placed
 758       // ourselves on its queue.
 759       // ASSERT(get_itbl(target)->type == TSO);
 760
 761       while (target->what_next == ThreadRelocated) {
 762           target = target->link;
 763       }
 764
 765       removeThreadFromQueue(&target->blocked_exceptions, tso);
 766       goto done;
 767     }
 768
 769 #if !defined(THREADED_RTS)
 770   case BlockedOnRead:
 771   case BlockedOnWrite:
 772 #if defined(mingw32_HOST_OS)
 773   case BlockedOnDoProc:
 774 #endif
 775       removeThreadFromDeQueue(&blocked_queue_hd, &blocked_queue_tl, tso);
 776 #if defined(mingw32_HOST_OS)
 777       /* (Cooperatively) signal that the worker thread should abort
 778        * the request.
 779        */
 780       abandonWorkRequest(tso->block_info.async_result->reqID);
 781 #endif
 782       goto done;
 783
 784   case BlockedOnDelay:
 785         removeThreadFromQueue(&sleeping_queue, tso);
 786         goto done;
 787 #endif
 788
 789   default:
 790       barf("removeFromQueues");
 791   }
 792
 793  done:
 794   tso->link = END_TSO_QUEUE;
 795   tso->why_blocked = NotBlocked;
 796   tso->block_info.closure = NULL;
 797   appendToRunQueue(cap,tso);
 798
 799   // We might have just migrated this TSO to our Capability:
 800   if (tso->bound) {
 801       tso->bound->cap = cap;
 802   }
 803   tso->cap = cap;
 804 }
 805 #endif
 806
 807 /* -----------------------------------------------------------------------------
 808  * raiseAsync()
 809  *
 810  * The following function implements the magic for raising an
 811  * asynchronous exception in an existing thread.
 812  *
 813  * We first remove the thread from any queue on which it might be
 814  * blocked.  The possible blockages are MVARs and BLACKHOLE_BQs.
 815  *
 816  * We strip the stack down to the innermost CATCH_FRAME, building
 817  * thunks in the heap for all the active computations, so they can
 818  * be restarted if necessary.  When we reach a CATCH_FRAME, we build
 819  * an application of the handler to the exception, and push it on
 820  * the top of the stack.
 821  *
 822  * How exactly do we save all the active computations?  We create an
 823  * AP_STACK for every UpdateFrame on the stack.  Entering one of these
 824  * AP_STACKs pushes everything from the corresponding update frame
 825  * upwards onto the stack.  (Actually, it pushes everything up to the
 826  * next update frame plus a pointer to the next AP_STACK object.
 827  * Entering the next AP_STACK object pushes more onto the stack until we
 828  * reach the last AP_STACK object - at which point the stack should look
 829  * exactly as it did when we killed the TSO and we can continue
 830  * execution by entering the closure on top of the stack.
 831  *
 832  * We can also kill a thread entirely - this happens if either (a) the
 833  * exception passed to raiseAsync is NULL, or (b) there's no
 834  * CATCH_FRAME on the stack.  In either case, we strip the entire
 835  * stack and replace the thread with a zombie.
 836  *
 837  * ToDo: in THREADED_RTS mode, this function is only safe if either
 838  * (a) we hold all the Capabilities (eg. in GC, or if there is only
 839  * one Capability), or (b) we own the Capability that the TSO is
 840  * currently blocked on or on the run queue of.
 841  *
 842  * -------------------------------------------------------------------------- */
 843
 844 static void
 845 raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 846            rtsBool stop_at_atomically, StgPtr stop_here)
 847 {
 848     StgRetInfoTable *info;
 849     StgPtr sp, frame;
 850     nat i;
 851
 852     debugTrace(DEBUG_sched,
 853                "raising exception in thread %ld.", (long)tso->id);
 854
 855     // mark it dirty; we're about to change its stack.
 856     dirtyTSO(tso);
 857
 858     sp = tso->sp;
 859
 860     // ASSUMES: the thread is not already complete or dead.  Upper
 861     // layers should deal with that.
 862     ASSERT(tso->what_next != ThreadComplete && tso->what_next != ThreadKilled);
 863
 864     // The stack freezing code assumes there's a closure pointer on
 865     // the top of the stack, so we have to arrange that this is the case...
 866     //
 867     if (sp[0] == (W_)&stg_enter_info) {
 868         sp++;
 869     } else {
 870         sp--;
 871         sp[0] = (W_)&stg_dummy_ret_closure;
 872     }
 873
 874     frame = sp + 1;
 875     while (stop_here == NULL || frame < stop_here) {
 876
 877         // 1. Let the top of the stack be the "current closure"
 878         //
 879         // 2. Walk up the stack until we find either an UPDATE_FRAME or a
 880         // CATCH_FRAME.
 881         //
 882         // 3. If it's an UPDATE_FRAME, then make an AP_STACK containing the
 883         // current closure applied to the chunk of stack up to (but not
 884         // including) the update frame.  This closure becomes the "current
 885         // closure".  Go back to step 2.
 886         //
 887         // 4. If it's a CATCH_FRAME, then leave the exception handler on
 888         // top of the stack applied to the exception.
 889         //
 890         // 5. If it's a STOP_FRAME, then kill the thread.
 891         //
 892         // NB: if we pass an ATOMICALLY_FRAME then abort the associated
 893         // transaction
 894
 895         info = get_ret_itbl((StgClosure *)frame);
 896
 897         switch (info->i.type) {
 898
 899         case UPDATE_FRAME:
 900         {
 901             StgAP_STACK * ap;
 902             nat words;
 903
 904             // First build an AP_STACK consisting of the stack chunk above the
 905             // current update frame, with the top word on the stack as the
 906             // fun field.
 907             //
 908             words = frame - sp - 1;
 909             ap = (StgAP_STACK *)allocateLocal(cap,AP_STACK_sizeW(words));
 910
 911             ap->size = words;
 912             ap->fun  = (StgClosure *)sp[0];
 913             sp++;
 914             for(i=0; i < (nat)words; ++i) {
 915                 ap->payload[i] = (StgClosure *)*sp++;
 916             }
 917
 918             SET_HDR(ap,&stg_AP_STACK_info,
 919                     ((StgClosure *)frame)->header.prof.ccs /* ToDo */);
 920             TICK_ALLOC_UP_THK(words+1,0);
 921
 922             //IF_DEBUG(scheduler,
 923             //       debugBelch("sched: Updating ");
 924             //       printPtr((P_)((StgUpdateFrame *)frame)->updatee);
 925             //       debugBelch(" with ");
 926             //       printObj((StgClosure *)ap);
 927             //  );
 928
 929             // Replace the updatee with an indirection
 930             //
 931             // Warning: if we're in a loop, more than one update frame on
 932             // the stack may point to the same object.  Be careful not to
 933             // overwrite an IND_OLDGEN in this case, because we'll screw
 934             // up the mutable lists.  To be on the safe side, don't
 935             // overwrite any kind of indirection at all.  See also
 936             // threadSqueezeStack in GC.c, where we have to make a similar
 937             // check.
 938             //
 939             if (!closure_IND(((StgUpdateFrame *)frame)->updatee)) {
 940                 // revert the black hole
 941                 UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
 942                                (StgClosure *)ap);
 943             }
 944             sp += sizeofW(StgUpdateFrame) - 1;
 945             sp[0] = (W_)ap; // push onto stack
 946             frame = sp + 1;
 947             continue; //no need to bump frame
 948         }
 949
 950         case STOP_FRAME:
 951         {
 952             // We've stripped the entire stack, the thread is now dead.
 953             tso->what_next = ThreadKilled;
 954             tso->sp = frame + sizeofW(StgStopFrame);
 955             return;
 956         }
 957
 958         case CATCH_FRAME:
 959             // If we find a CATCH_FRAME, and we've got an exception to raise,
 960             // then build the THUNK raise(exception), and leave it on
 961             // top of the CATCH_FRAME ready to enter.
 962             //
 963         {
 964 #ifdef PROFILING
 965             StgCatchFrame *cf = (StgCatchFrame *)frame;
 966 #endif
 967             StgThunk *raise;
 968
 969             if (exception == NULL) break;
 970
 971             // we've got an exception to raise, so let's pass it to the
 972             // handler in this frame.
 973             //
 974             raise = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
 975             TICK_ALLOC_SE_THK(1,0);
 976             SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
 977             raise->payload[0] = exception;
 978
 979             // throw away the stack from Sp up to the CATCH_FRAME.
 980             //
 981             sp = frame - 1;
 982
 983             /* Ensure that async excpetions are blocked now, so we don't get
 984              * a surprise exception before we get around to executing the
 985              * handler.
 986              */
 987             tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
 988
 989             /* Put the newly-built THUNK on top of the stack, ready to execute
 990              * when the thread restarts.
 991              */
 992             sp[0] = (W_)raise;
 993             sp[-1] = (W_)&stg_enter_info;
 994             tso->sp = sp-1;
 995             tso->what_next = ThreadRunGHC;
 996             IF_DEBUG(sanity, checkTSO(tso));
 997             return;
 998         }
 999
1000         case ATOMICALLY_FRAME:
1001             if (stop_at_atomically) {
1002                 ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
1003                 stmCondemnTransaction(cap, tso -> trec);
1004 #ifdef REG_R1
1005                 tso->sp = frame;
1006 #else
1007                 // R1 is not a register: the return convention for IO in
1008                 // this case puts the return value on the stack, so we
1009                 // need to set up the stack to return to the atomically
1010                 // frame properly...
1011                 tso->sp = frame - 2;
1012                 tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
1013                 tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
1014 #endif
1015                 tso->what_next = ThreadRunGHC;
1016                 return;
1017             }
1018             // Not stop_at_atomically... fall through and abort the
1019             // transaction.
1020
1021         case CATCH_RETRY_FRAME:
1022             // IF we find an ATOMICALLY_FRAME then we abort the
1023             // current transaction and propagate the exception.  In
1024             // this case (unlike ordinary exceptions) we do not care
1025             // whether the transaction is valid or not because its
1026             // possible validity cannot have caused the exception
1027             // and will not be visible after the abort.
1028
1029                 {
1030             StgTRecHeader *trec = tso -> trec;
1031             StgTRecHeader *outer = stmGetEnclosingTRec(trec);
1032             debugTrace(DEBUG_stm,
1033                        "found atomically block delivering async exception");
1034             stmAbortTransaction(cap, trec);
1035             stmFreeAbortedTRec(cap, trec);
1036             tso -> trec = outer;
1037             break;
1038             };
1039
1040         default:
1041             break;
1042         }
1043
1044         // move on to the next stack frame
1045         frame += stack_frame_sizeW((StgClosure *)frame);
1046     }
1047
1048     // if we got here, then we stopped at stop_here
1049     ASSERT(stop_here != NULL);
1050 }
1051
1052