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
  12 #include "sm/Storage.h"
  13 #include "Threads.h"
  14 #include "Trace.h"
  15 #include "RaiseAsync.h"
  16 #include "Schedule.h"
  17 #include "Updates.h"
  18 #include "STM.h"
  19 #include "sm/Sanity.h"
  20 #include "Profiling.h"
  21 #include "Messages.h"
  22 #if defined(mingw32_HOST_OS)
  23 #include "win32/IOManager.h"
  24 #endif
  25
  26 static void raiseAsync (Capability *cap,
  27                         StgTSO *tso,
  28                         StgClosure *exception,
  29                         rtsBool stop_at_atomically,
  30                         StgUpdateFrame *stop_here);
  31
  32 static void removeFromQueues(Capability *cap, StgTSO *tso);
  33
  34 static void blockedThrowTo (Capability *cap,
  35                             StgTSO *target, MessageThrowTo *msg);
  36
  37 static void throwToSendMsg (Capability *cap USED_IF_THREADS,
  38                             Capability *target_cap USED_IF_THREADS,
  39                             MessageThrowTo *msg USED_IF_THREADS);
  40
  41 /* -----------------------------------------------------------------------------
  42    throwToSingleThreaded
  43
  44    This version of throwTo is safe to use if and only if one of the
  45    following holds:
  46
  47      - !THREADED_RTS
  48
  49      - all the other threads in the system are stopped (eg. during GC).
  50
  51      - we surely own the target TSO (eg. we just took it from the
  52        run queue of the current capability, or we are running it).
  53
  54    It doesn't cater for blocking the source thread until the exception
  55    has been raised.
  56    -------------------------------------------------------------------------- */
  57
  58 void
  59 throwToSingleThreaded(Capability *cap, StgTSO *tso, StgClosure *exception)
  60 {
  61     throwToSingleThreaded_(cap, tso, exception, rtsFalse);
  62 }
  63
  64 void
  65 throwToSingleThreaded_(Capability *cap, StgTSO *tso, StgClosure *exception,
  66                        rtsBool stop_at_atomically)
  67 {
  68     tso = deRefTSO(tso);
  69
  70     // Thread already dead?
  71     if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
  72         return;
  73     }
  74
  75     // Remove it from any blocking queues
  76     removeFromQueues(cap,tso);
  77
  78     raiseAsync(cap, tso, exception, stop_at_atomically, NULL);
  79 }
  80
  81 void
  82 suspendComputation(Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
  83 {
  84     tso = deRefTSO(tso);
  85
  86     // Thread already dead?
  87     if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
  88         return;
  89     }
  90
  91     // Remove it from any blocking queues
  92     removeFromQueues(cap,tso);
  93
  94     raiseAsync(cap, tso, NULL, rtsFalse, stop_here);
  95 }
  96
  97 /* -----------------------------------------------------------------------------
  98    throwTo
  99
 100    This function may be used to throw an exception from one thread to
 101    another, during the course of normal execution.  This is a tricky
 102    task: the target thread might be running on another CPU, or it
 103    may be blocked and could be woken up at any point by another CPU.
 104    We have some delicate synchronisation to do.
 105
 106    The underlying scheme when multiple Capabilities are in use is
 107    message passing: when the target of a throwTo is on another
 108    Capability, we send a message (a MessageThrowTo closure) to that
 109    Capability.
 110
 111    If the throwTo needs to block because the target TSO is masking
 112    exceptions (the TSO_BLOCKEX flag), then the message is placed on
 113    the blocked_exceptions queue attached to the target TSO.  When the
 114    target TSO enters the unmasked state again, it must check the
 115    queue.  The blocked_exceptions queue is not locked; only the
 116    Capability owning the TSO may modify it.
 117
 118    To make things simpler for throwTo, we always create the message
 119    first before deciding what to do.  The message may get sent, or it
 120    may get attached to a TSO's blocked_exceptions queue, or the
 121    exception may get thrown immediately and the message dropped,
 122    depending on the current state of the target.
 123
 124    Currently we send a message if the target belongs to another
 125    Capability, and it is
 126
 127      - NotBlocked, BlockedOnMsgWakeup, BlockedOnMsgThrowTo,
 128        BlockedOnCCall
 129
 130      - or it is masking exceptions (TSO_BLOCKEX)
 131
 132    Currently, if the target is BlockedOnMVar, BlockedOnSTM, or
 133    BlockedOnBlackHole then we acquire ownership of the TSO by locking
 134    its parent container (e.g. the MVar) and then raise the exception.
 135    We might change these cases to be more message-passing-like in the
 136    future.
 137
 138    Returns:
 139
 140    NULL               exception was raised, ok to continue
 141
 142    MessageThrowTo *   exception was not raised; the source TSO
 143                       should now put itself in the state
 144                       BlockedOnMsgThrowTo, and when it is ready
 145                       it should unlock the mssage using
 146                       unlockClosure(msg, &stg_MSG_THROWTO_info);
 147                       If it decides not to raise the exception after
 148                       all, it can revoke it safely with
 149                       unlockClosure(msg, &stg_MSG_NULL_info);
 150
 151    -------------------------------------------------------------------------- */
 152
 153 MessageThrowTo *
 154 throwTo (Capability *cap,       // the Capability we hold
 155          StgTSO *source,        // the TSO sending the exception (or NULL)
 156          StgTSO *target,        // the TSO receiving the exception
 157          StgClosure *exception) // the exception closure
 158 {
 159     MessageThrowTo *msg;
 160
 161     msg = (MessageThrowTo *) allocate(cap, sizeofW(MessageThrowTo));
 162     // message starts locked; the caller has to unlock it when it is
 163     // ready.
 164     SET_HDR(msg, &stg_WHITEHOLE_info, CCS_SYSTEM);
 165     msg->source      = source;
 166     msg->target      = target;
 167     msg->exception   = exception;
 168
 169     switch (throwToMsg(cap, msg))
 170     {
 171     case THROWTO_SUCCESS:
 172         return NULL;
 173     case THROWTO_BLOCKED:
 174     default:
 175         return msg;
 176     }
 177 }
 178
 179
 180 nat
 181 throwToMsg (Capability *cap, MessageThrowTo *msg)
 182 {
 183     StgWord status;
 184     StgTSO *target = msg->target;
 185     Capability *target_cap;
 186
 187     goto check_target;
 188
 189 retry:
 190     write_barrier();
 191     debugTrace(DEBUG_sched, "throwTo: retrying...");
 192
 193 check_target:
 194     ASSERT(target != END_TSO_QUEUE);
 195
 196     // follow ThreadRelocated links in the target first
 197     target = deRefTSO(target);
 198
 199     // Thread already dead?
 200     if (target->what_next == ThreadComplete
 201         || target->what_next == ThreadKilled) {
 202         return THROWTO_SUCCESS;
 203     }
 204
 205     debugTraceCap(DEBUG_sched, cap,
 206                   "throwTo: from thread %lu to thread %lu",
 207                   (unsigned long)msg->source->id,
 208                   (unsigned long)msg->target->id);
 209
 210 #ifdef DEBUG
 211     traceThreadStatus(DEBUG_sched, target);
 212 #endif
 213
 214     target_cap = target->cap;
 215     if (target->cap != cap) {
 216         throwToSendMsg(cap, target_cap, msg);
 217         return THROWTO_BLOCKED;
 218     }
 219
 220     status = target->why_blocked;
 221
 222     switch (status) {
 223     case NotBlocked:
 224     case BlockedOnMsgWakeup:
 225         /* if status==NotBlocked, and target->cap == cap, then
 226            we own this TSO and can raise the exception.
 227
 228            How do we establish this condition?  Very carefully.
 229
 230            Let
 231                P = (status == NotBlocked)
 232                Q = (tso->cap == cap)
 233
 234            Now, if P & Q are true, then the TSO is locked and owned by
 235            this capability.  No other OS thread can steal it.
 236
 237            If P==0 and Q==1: the TSO is blocked, but attached to this
 238            capabilty, and it can be stolen by another capability.
 239
 240            If P==1 and Q==0: the TSO is runnable on another
 241            capability.  At any time, the TSO may change from runnable
 242            to blocked and vice versa, while it remains owned by
 243            another capability.
 244
 245            Suppose we test like this:
 246
 247               p = P
 248               q = Q
 249               if (p && q) ...
 250
 251             this is defeated by another capability stealing a blocked
 252             TSO from us to wake it up (Schedule.c:unblockOne()).  The
 253             other thread is doing
 254
 255               Q = 0
 256               P = 1
 257
 258             assuming arbitrary reordering, we could see this
 259             interleaving:
 260
 261               start: P==0 && Q==1
 262               P = 1
 263               p = P
 264               q = Q
 265               Q = 0
 266               if (p && q) ...
 267
 268             so we need a memory barrier:
 269
 270               p = P
 271               mb()
 272               q = Q
 273               if (p && q) ...
 274
 275             this avoids the problematic case.  There are other cases
 276             to consider, but this is the tricky one.
 277
 278             Note that we must be sure that unblockOne() does the
 279             writes in the correct order: Q before P.  The memory
 280             barrier ensures that if we have seen the write to P, we
 281             have also seen the write to Q.
 282         */
 283     {
 284         write_barrier();
 285         if ((target->flags & TSO_BLOCKEX) == 0) {
 286             // It's on our run queue and not blocking exceptions
 287             raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
 288             return THROWTO_SUCCESS;
 289         } else {
 290             blockedThrowTo(cap,target,msg);
 291             return THROWTO_BLOCKED;
 292         }
 293     }
 294
 295     case BlockedOnMsgThrowTo:
 296     {
 297         const StgInfoTable *i;
 298         MessageThrowTo *m;
 299
 300         m = target->block_info.throwto;
 301
 302         // target is local to this cap, but has sent a throwto
 303         // message to another cap.
 304         //
 305         // The source message is locked.  We need to revoke the
 306         // target's message so that we can raise the exception, so
 307         // we attempt to lock it.
 308
 309         // There's a possibility of a deadlock if two threads are both
 310         // trying to throwTo each other (or more generally, a cycle of
 311         // threads).  To break the symmetry we compare the addresses
 312         // of the MessageThrowTo objects, and the one for which m <
 313         // msg gets to spin, while the other can only try to lock
 314         // once, but must then back off and unlock both before trying
 315         // again.
 316         if (m < msg) {
 317             i = lockClosure((StgClosure *)m);
 318         } else {
 319             i = tryLockClosure((StgClosure *)m);
 320             if (i == NULL) {
 321 //            debugBelch("collision\n");
 322                 throwToSendMsg(cap, target->cap, msg);
 323                 return THROWTO_BLOCKED;
 324             }
 325         }
 326
 327         if (i == &stg_MSG_NULL_info) {
 328             // we know there's a MSG_TRY_WAKEUP on the way, so we
 329             // might as well just do it now.  The message will
 330             // be a no-op when it arrives.
 331             unlockClosure((StgClosure*)m, i);
 332             tryWakeupThread(cap, target);
 333             goto retry;
 334         }
 335
 336         if (i != &stg_MSG_THROWTO_info) {
 337             // if it's a MSG_NULL, this TSO has been woken up by another Cap
 338             unlockClosure((StgClosure*)m, i);
 339             goto retry;
 340         }
 341
 342         if ((target->flags & TSO_BLOCKEX) &&
 343             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 344             unlockClosure((StgClosure*)m, i);
 345             blockedThrowTo(cap,target,msg);
 346             return THROWTO_BLOCKED;
 347         }
 348
 349         // nobody else can wake up this TSO after we claim the message
 350         unlockClosure((StgClosure*)m, &stg_MSG_NULL_info);
 351
 352         raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
 353         return THROWTO_SUCCESS;
 354     }
 355
 356     case BlockedOnMVar:
 357     {
 358         /*
 359           To establish ownership of this TSO, we need to acquire a
 360           lock on the MVar that it is blocked on.
 361         */
 362         StgMVar *mvar;
 363         StgInfoTable *info USED_IF_THREADS;
 364
 365         mvar = (StgMVar *)target->block_info.closure;
 366
 367         // ASSUMPTION: tso->block_info must always point to a
 368         // closure.  In the threaded RTS it does.
 369         switch (get_itbl(mvar)->type) {
 370         case MVAR_CLEAN:
 371         case MVAR_DIRTY:
 372             break;
 373         default:
 374             goto retry;
 375         }
 376
 377         info = lockClosure((StgClosure *)mvar);
 378
 379         if (target->what_next == ThreadRelocated) {
 380             target = target->_link;
 381             unlockClosure((StgClosure *)mvar,info);
 382             goto retry;
 383         }
 384         // we have the MVar, let's check whether the thread
 385         // is still blocked on the same MVar.
 386         if (target->why_blocked != BlockedOnMVar
 387             || (StgMVar *)target->block_info.closure != mvar) {
 388             unlockClosure((StgClosure *)mvar, info);
 389             goto retry;
 390         }
 391
 392         if ((target->flags & TSO_BLOCKEX) &&
 393             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 394             blockedThrowTo(cap,target,msg);
 395             unlockClosure((StgClosure *)mvar, info);
 396             return THROWTO_BLOCKED;
 397         } else {
 398             removeThreadFromMVarQueue(cap, mvar, target);
 399             raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
 400             if (info == &stg_MVAR_CLEAN_info) {
 401                 dirty_MVAR(&cap->r,(StgClosure*)mvar);
 402             }
 403             unlockClosure((StgClosure *)mvar, &stg_MVAR_DIRTY_info);
 404             return THROWTO_SUCCESS;
 405         }
 406     }
 407
 408     case BlockedOnBlackHole:
 409     {
 410         // Revoke the message by replacing it with IND. We're not
 411         // locking anything here, so we might still get a TRY_WAKEUP
 412         // message from the owner of the blackhole some time in the
 413         // future, but that doesn't matter.
 414         ASSERT(target->block_info.bh->header.info == &stg_MSG_BLACKHOLE_info);
 415         OVERWRITE_INFO(target->block_info.bh, &stg_IND_info);
 416         raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
 417         return THROWTO_SUCCESS;
 418     }
 419
 420     case BlockedOnSTM:
 421         lockTSO(target);
 422         // Unblocking BlockedOnSTM threads requires the TSO to be
 423         // locked; see STM.c:unpark_tso().
 424         if (target->why_blocked != BlockedOnSTM) {
 425             unlockTSO(target);
 426             goto retry;
 427         }
 428         if ((target->flags & TSO_BLOCKEX) &&
 429             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 430             blockedThrowTo(cap,target,msg);
 431             unlockTSO(target);
 432             return THROWTO_BLOCKED;
 433         } else {
 434             raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
 435             unlockTSO(target);
 436             return THROWTO_SUCCESS;
 437         }
 438
 439     case BlockedOnCCall:
 440     case BlockedOnCCall_NoUnblockExc:
 441         blockedThrowTo(cap,target,msg);
 442         return THROWTO_BLOCKED;
 443
 444 #ifndef THREADEDED_RTS
 445     case BlockedOnRead:
 446     case BlockedOnWrite:
 447     case BlockedOnDelay:
 448 #if defined(mingw32_HOST_OS)
 449     case BlockedOnDoProc:
 450 #endif
 451         if ((target->flags & TSO_BLOCKEX) &&
 452             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 453             blockedThrowTo(cap,target,msg);
 454             return THROWTO_BLOCKED;
 455         } else {
 456             removeFromQueues(cap,target);
 457             raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
 458             return THROWTO_SUCCESS;
 459         }
 460 #endif
 461
 462     default:
 463         barf("throwTo: unrecognised why_blocked value");
 464     }
 465     barf("throwTo");
 466 }
 467
 468 static void
 469 throwToSendMsg (Capability *cap STG_UNUSED,
 470                 Capability *target_cap USED_IF_THREADS,
 471                 MessageThrowTo *msg USED_IF_THREADS)
 472
 473 {
 474 #ifdef THREADED_RTS
 475     debugTraceCap(DEBUG_sched, cap, "throwTo: sending a throwto message to cap %lu", (unsigned long)target_cap->no);
 476
 477     sendMessage(cap, target_cap, (Message*)msg);
 478 #endif
 479 }
 480
 481 // Block a throwTo message on the target TSO's blocked_exceptions
 482 // queue.  The current Capability must own the target TSO in order to
 483 // modify the blocked_exceptions queue.
 484 static void
 485 blockedThrowTo (Capability *cap, StgTSO *target, MessageThrowTo *msg)
 486 {
 487     debugTraceCap(DEBUG_sched, cap, "throwTo: blocking on thread %lu",
 488                   (unsigned long)target->id);
 489
 490     ASSERT(target->cap == cap);
 491
 492     msg->link = target->blocked_exceptions;
 493     target->blocked_exceptions = msg;
 494     dirty_TSO(cap,target); // we modified the blocked_exceptions queue
 495 }
 496
 497 /* -----------------------------------------------------------------------------
 498    Waking up threads blocked in throwTo
 499
 500    There are two ways to do this: maybePerformBlockedException() will
 501    perform the throwTo() for the thread at the head of the queue
 502    immediately, and leave the other threads on the queue.
 503    maybePerformBlockedException() also checks the TSO_BLOCKEX flag
 504    before raising an exception.
 505
 506    awakenBlockedExceptionQueue() will wake up all the threads in the
 507    queue, but not perform any throwTo() immediately.  This might be
 508    more appropriate when the target thread is the one actually running
 509    (see Exception.cmm).
 510
 511    Returns: non-zero if an exception was raised, zero otherwise.
 512    -------------------------------------------------------------------------- */
 513
 514 int
 515 maybePerformBlockedException (Capability *cap, StgTSO *tso)
 516 {
 517     MessageThrowTo *msg;
 518     const StgInfoTable *i;
 519
 520     if (tso->what_next == ThreadComplete || tso->what_next == ThreadFinished) {
 521         if (tso->blocked_exceptions != END_BLOCKED_EXCEPTIONS_QUEUE) {
 522             awakenBlockedExceptionQueue(cap,tso);
 523             return 1;
 524         } else {
 525             return 0;
 526         }
 527     }
 528
 529     if (tso->blocked_exceptions != END_BLOCKED_EXCEPTIONS_QUEUE &&
 530         (tso->flags & TSO_BLOCKEX) != 0) {
 531         debugTraceCap(DEBUG_sched, cap, "throwTo: thread %lu has blocked exceptions but is inside block", (unsigned long)tso->id);
 532     }
 533
 534     if (tso->blocked_exceptions != END_BLOCKED_EXCEPTIONS_QUEUE
 535         && ((tso->flags & TSO_BLOCKEX) == 0
 536             || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) {
 537
 538         // We unblock just the first thread on the queue, and perform
 539         // its throw immediately.
 540     loop:
 541         msg = tso->blocked_exceptions;
 542         if (msg == END_BLOCKED_EXCEPTIONS_QUEUE) return 0;
 543         i = lockClosure((StgClosure*)msg);
 544         tso->blocked_exceptions = (MessageThrowTo*)msg->link;
 545         if (i == &stg_MSG_NULL_info) {
 546             unlockClosure((StgClosure*)msg,i);
 547             goto loop;
 548         }
 549
 550         throwToSingleThreaded(cap, msg->target, msg->exception);
 551         unlockClosure((StgClosure*)msg,&stg_MSG_NULL_info);
 552         tryWakeupThread(cap, msg->source);
 553         return 1;
 554     }
 555     return 0;
 556 }
 557
 558 // awakenBlockedExceptionQueue(): Just wake up the whole queue of
 559 // blocked exceptions.
 560
 561 void
 562 awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso)
 563 {
 564     MessageThrowTo *msg;
 565     const StgInfoTable *i;
 566
 567     for (msg = tso->blocked_exceptions; msg != END_BLOCKED_EXCEPTIONS_QUEUE;
 568          msg = (MessageThrowTo*)msg->link) {
 569         i = lockClosure((StgClosure *)msg);
 570         if (i != &stg_MSG_NULL_info) {
 571             unlockClosure((StgClosure *)msg,&stg_MSG_NULL_info);
 572             tryWakeupThread(cap, msg->source);
 573         } else {
 574             unlockClosure((StgClosure *)msg,i);
 575         }
 576     }
 577     tso->blocked_exceptions = END_BLOCKED_EXCEPTIONS_QUEUE;
 578 }
 579
 580 /* -----------------------------------------------------------------------------
 581    Remove a thread from blocking queues.
 582
 583    This is for use when we raise an exception in another thread, which
 584    may be blocked.
 585
 586    Precondition: we have exclusive access to the TSO, via the same set
 587    of conditions as throwToSingleThreaded() (c.f.).
 588    -------------------------------------------------------------------------- */
 589
 590 static void
 591 removeFromQueues(Capability *cap, StgTSO *tso)
 592 {
 593   switch (tso->why_blocked) {
 594
 595   case NotBlocked:
 596       return;
 597
 598   case BlockedOnSTM:
 599     // Be careful: nothing to do here!  We tell the scheduler that the
 600     // thread is runnable and we leave it to the stack-walking code to
 601     // abort the transaction while unwinding the stack.  We should
 602     // perhaps have a debugging test to make sure that this really
 603     // happens and that the 'zombie' transaction does not get
 604     // committed.
 605     goto done;
 606
 607   case BlockedOnMVar:
 608       removeThreadFromMVarQueue(cap, (StgMVar *)tso->block_info.closure, tso);
 609       // we aren't doing a write barrier here: the MVar is supposed to
 610       // be already locked, so replacing the info pointer would unlock it.
 611       goto done;
 612
 613   case BlockedOnBlackHole:
 614       // nothing to do
 615       goto done;
 616
 617   case BlockedOnMsgWakeup:
 618   {
 619       // kill the message, atomically:
 620       OVERWRITE_INFO(tso->block_info.wakeup, &stg_IND_info);
 621       break;
 622   }
 623
 624   case BlockedOnMsgThrowTo:
 625   {
 626       MessageThrowTo *m = tso->block_info.throwto;
 627       // The message is locked by us, unless we got here via
 628       // deleteAllThreads(), in which case we own all the
 629       // capabilities.
 630       // ASSERT(m->header.info == &stg_WHITEHOLE_info);
 631
 632       // unlock and revoke it at the same time
 633       unlockClosure((StgClosure*)m,&stg_MSG_NULL_info);
 634       break;
 635   }
 636
 637 #if !defined(THREADED_RTS)
 638   case BlockedOnRead:
 639   case BlockedOnWrite:
 640 #if defined(mingw32_HOST_OS)
 641   case BlockedOnDoProc:
 642 #endif
 643       removeThreadFromDeQueue(cap, &blocked_queue_hd, &blocked_queue_tl, tso);
 644 #if defined(mingw32_HOST_OS)
 645       /* (Cooperatively) signal that the worker thread should abort
 646        * the request.
 647        */
 648       abandonWorkRequest(tso->block_info.async_result->reqID);
 649 #endif
 650       goto done;
 651
 652   case BlockedOnDelay:
 653         removeThreadFromQueue(cap, &sleeping_queue, tso);
 654         goto done;
 655 #endif
 656
 657   default:
 658       barf("removeFromQueues: %d", tso->why_blocked);
 659   }
 660
 661  done:
 662   unblockOne(cap, tso);
 663 }
 664
 665 /* -----------------------------------------------------------------------------
 666  * raiseAsync()
 667  *
 668  * The following function implements the magic for raising an
 669  * asynchronous exception in an existing thread.
 670  *
 671  * We first remove the thread from any queue on which it might be
 672  * blocked.  The possible blockages are MVARs, BLOCKING_QUEUESs, and
 673  * TSO blocked_exception queues.
 674  *
 675  * We strip the stack down to the innermost CATCH_FRAME, building
 676  * thunks in the heap for all the active computations, so they can
 677  * be restarted if necessary.  When we reach a CATCH_FRAME, we build
 678  * an application of the handler to the exception, and push it on
 679  * the top of the stack.
 680  *
 681  * How exactly do we save all the active computations?  We create an
 682  * AP_STACK for every UpdateFrame on the stack.  Entering one of these
 683  * AP_STACKs pushes everything from the corresponding update frame
 684  * upwards onto the stack.  (Actually, it pushes everything up to the
 685  * next update frame plus a pointer to the next AP_STACK object.
 686  * Entering the next AP_STACK object pushes more onto the stack until we
 687  * reach the last AP_STACK object - at which point the stack should look
 688  * exactly as it did when we killed the TSO and we can continue
 689  * execution by entering the closure on top of the stack.
 690  *
 691  * We can also kill a thread entirely - this happens if either (a) the
 692  * exception passed to raiseAsync is NULL, or (b) there's no
 693  * CATCH_FRAME on the stack.  In either case, we strip the entire
 694  * stack and replace the thread with a zombie.
 695  *
 696  * ToDo: in THREADED_RTS mode, this function is only safe if either
 697  * (a) we hold all the Capabilities (eg. in GC, or if there is only
 698  * one Capability), or (b) we own the Capability that the TSO is
 699  * currently blocked on or on the run queue of.
 700  *
 701  * -------------------------------------------------------------------------- */
 702
 703 static void
 704 raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 705            rtsBool stop_at_atomically, StgUpdateFrame *stop_here)
 706 {
 707     StgRetInfoTable *info;
 708     StgPtr sp, frame;
 709     StgClosure *updatee;
 710     nat i;
 711
 712     debugTraceCap(DEBUG_sched, cap,
 713                   "raising exception in thread %ld.", (long)tso->id);
 714
 715 #if defined(PROFILING)
 716     /*
 717      * Debugging tool: on raising an  exception, show where we are.
 718      * See also Exception.cmm:stg_raisezh.
 719      * This wasn't done for asynchronous exceptions originally; see #1450
 720      */
 721     if (RtsFlags.ProfFlags.showCCSOnException)
 722     {
 723         fprintCCS_stderr(tso->prof.CCCS);
 724     }
 725 #endif
 726     // ASSUMES: the thread is not already complete or dead, or
 727     // ThreadRelocated.  Upper layers should deal with that.
 728     ASSERT(tso->what_next != ThreadComplete &&
 729            tso->what_next != ThreadKilled &&
 730            tso->what_next != ThreadRelocated);
 731
 732     // only if we own this TSO (except that deleteThread() calls this
 733     ASSERT(tso->cap == cap);
 734
 735     // wake it up
 736     if (tso->why_blocked != NotBlocked && tso->why_blocked != BlockedOnMsgWakeup) {
 737         tso->why_blocked = NotBlocked;
 738         appendToRunQueue(cap,tso);
 739     }
 740
 741     // mark it dirty; we're about to change its stack.
 742     dirty_TSO(cap, tso);
 743
 744     sp = tso->sp;
 745
 746     if (stop_here != NULL) {
 747         updatee = stop_here->updatee;
 748     } else {
 749         updatee = NULL;
 750     }
 751
 752     // The stack freezing code assumes there's a closure pointer on
 753     // the top of the stack, so we have to arrange that this is the case...
 754     //
 755     if (sp[0] == (W_)&stg_enter_info) {
 756         sp++;
 757     } else {
 758         sp--;
 759         sp[0] = (W_)&stg_dummy_ret_closure;
 760     }
 761
 762     frame = sp + 1;
 763     while (stop_here == NULL || frame < (StgPtr)stop_here) {
 764
 765         // 1. Let the top of the stack be the "current closure"
 766         //
 767         // 2. Walk up the stack until we find either an UPDATE_FRAME or a
 768         // CATCH_FRAME.
 769         //
 770         // 3. If it's an UPDATE_FRAME, then make an AP_STACK containing the
 771         // current closure applied to the chunk of stack up to (but not
 772         // including) the update frame.  This closure becomes the "current
 773         // closure".  Go back to step 2.
 774         //
 775         // 4. If it's a CATCH_FRAME, then leave the exception handler on
 776         // top of the stack applied to the exception.
 777         //
 778         // 5. If it's a STOP_FRAME, then kill the thread.
 779         //
 780         // NB: if we pass an ATOMICALLY_FRAME then abort the associated
 781         // transaction
 782
 783         info = get_ret_itbl((StgClosure *)frame);
 784
 785         switch (info->i.type) {
 786
 787         case UPDATE_FRAME:
 788         {
 789             StgAP_STACK * ap;
 790             nat words;
 791
 792             // First build an AP_STACK consisting of the stack chunk above the
 793             // current update frame, with the top word on the stack as the
 794             // fun field.
 795             //
 796             words = frame - sp - 1;
 797             ap = (StgAP_STACK *)allocate(cap,AP_STACK_sizeW(words));
 798
 799             ap->size = words;
 800             ap->fun  = (StgClosure *)sp[0];
 801             sp++;
 802             for(i=0; i < (nat)words; ++i) {
 803                 ap->payload[i] = (StgClosure *)*sp++;
 804             }
 805
 806             SET_HDR(ap,&stg_AP_STACK_info,
 807                     ((StgClosure *)frame)->header.prof.ccs /* ToDo */);
 808             TICK_ALLOC_UP_THK(words+1,0);
 809
 810             //IF_DEBUG(scheduler,
 811             //       debugBelch("sched: Updating ");
 812             //       printPtr((P_)((StgUpdateFrame *)frame)->updatee);
 813             //       debugBelch(" with ");
 814             //       printObj((StgClosure *)ap);
 815             //  );
 816
 817             if (((StgUpdateFrame *)frame)->updatee == updatee) {
 818                 // If this update frame points to the same closure as
 819                 // the update frame further down the stack
 820                 // (stop_here), then don't perform the update.  We
 821                 // want to keep the blackhole in this case, so we can
 822                 // detect and report the loop (#2783).
 823                 ap = (StgAP_STACK*)updatee;
 824             } else {
 825                 // Perform the update
 826                 // TODO: this may waste some work, if the thunk has
 827                 // already been updated by another thread.
 828                 updateThunk(cap, tso,
 829                             ((StgUpdateFrame *)frame)->updatee, (StgClosure *)ap);
 830             }
 831
 832             sp += sizeofW(StgUpdateFrame) - 1;
 833             sp[0] = (W_)ap; // push onto stack
 834             frame = sp + 1;
 835             continue; //no need to bump frame
 836         }
 837
 838         case STOP_FRAME:
 839         {
 840             // We've stripped the entire stack, the thread is now dead.
 841             tso->what_next = ThreadKilled;
 842             tso->sp = frame + sizeofW(StgStopFrame);
 843             return;
 844         }
 845
 846         case CATCH_FRAME:
 847             // If we find a CATCH_FRAME, and we've got an exception to raise,
 848             // then build the THUNK raise(exception), and leave it on
 849             // top of the CATCH_FRAME ready to enter.
 850             //
 851         {
 852 #ifdef PROFILING
 853             StgCatchFrame *cf = (StgCatchFrame *)frame;
 854 #endif
 855             StgThunk *raise;
 856
 857             if (exception == NULL) break;
 858
 859             // we've got an exception to raise, so let's pass it to the
 860             // handler in this frame.
 861             //
 862             raise = (StgThunk *)allocate(cap,sizeofW(StgThunk)+1);
 863             TICK_ALLOC_SE_THK(1,0);
 864             SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
 865             raise->payload[0] = exception;
 866
 867             // throw away the stack from Sp up to the CATCH_FRAME.
 868             //
 869             sp = frame - 1;
 870
 871             /* Ensure that async excpetions are blocked now, so we don't get
 872              * a surprise exception before we get around to executing the
 873              * handler.
 874              */
 875             tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
 876
 877             /* Put the newly-built THUNK on top of the stack, ready to execute
 878              * when the thread restarts.
 879              */
 880             sp[0] = (W_)raise;
 881             sp[-1] = (W_)&stg_enter_info;
 882             tso->sp = sp-1;
 883             tso->what_next = ThreadRunGHC;
 884             IF_DEBUG(sanity, checkTSO(tso));
 885             return;
 886         }
 887
 888         case ATOMICALLY_FRAME:
 889             if (stop_at_atomically) {
 890                 ASSERT(tso->trec->enclosing_trec == NO_TREC);
 891                 stmCondemnTransaction(cap, tso -> trec);
 892                 tso->sp = frame - 2;
 893                 // The ATOMICALLY_FRAME expects to be returned a
 894                 // result from the transaction, which it stores in the
 895                 // stack frame.  Hence we arrange to return a dummy
 896                 // result, so that the GC doesn't get upset (#3578).
 897                 // Perhaps a better way would be to have a different
 898                 // ATOMICALLY_FRAME instance for condemned
 899                 // transactions, but I don't fully understand the
 900                 // interaction with STM invariants.
 901                 tso->sp[1] = (W_)&stg_NO_TREC_closure;
 902                 tso->sp[0] = (W_)&stg_gc_unpt_r1_info;
 903                 tso->what_next = ThreadRunGHC;
 904                 return;
 905             }
 906             // Not stop_at_atomically... fall through and abort the
 907             // transaction.
 908
 909         case CATCH_STM_FRAME:
 910         case CATCH_RETRY_FRAME:
 911             // IF we find an ATOMICALLY_FRAME then we abort the
 912             // current transaction and propagate the exception.  In
 913             // this case (unlike ordinary exceptions) we do not care
 914             // whether the transaction is valid or not because its
 915             // possible validity cannot have caused the exception
 916             // and will not be visible after the abort.
 917
 918                 {
 919             StgTRecHeader *trec = tso -> trec;
 920             StgTRecHeader *outer = trec -> enclosing_trec;
 921             debugTraceCap(DEBUG_stm, cap,
 922                           "found atomically block delivering async exception");
 923             stmAbortTransaction(cap, trec);
 924             stmFreeAbortedTRec(cap, trec);
 925             tso -> trec = outer;
 926             break;
 927             };
 928
 929         default:
 930             break;
 931         }
 932
 933         // move on to the next stack frame
 934         frame += stack_frame_sizeW((StgClosure *)frame);
 935     }
 936
 937     // if we got here, then we stopped at stop_here
 938     ASSERT(stop_here != NULL);
 939 }
 940
 941