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