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