rts/RaiseAsync.c

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