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