rts/RaiseAsync.c

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