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