rts/Exception.cmm

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2004
   4  *
   5  * Exception support
   6  *
   7  * This file is written in a subset of C--, extended with various
   8  * features specific to GHC.  It is compiled by GHC directly.  For the
   9  * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
  10  *
  11  * ---------------------------------------------------------------------------*/
  12
  13 #include "Cmm.h"
  14
  15 /* -----------------------------------------------------------------------------
  16    Exception Primitives
  17
  18    A thread can request that asynchronous exceptions not be delivered
  19    ("blocked") for the duration of an I/O computation.  The primitive
  20
  21         blockAsyncExceptions# :: IO a -> IO a
  22
  23    is used for this purpose.  During a blocked section, asynchronous
  24    exceptions may be unblocked again temporarily:
  25
  26         unblockAsyncExceptions# :: IO a -> IO a
  27
  28    Furthermore, asynchronous exceptions are blocked automatically during
  29    the execution of an exception handler.  Both of these primitives
  30    leave a continuation on the stack which reverts to the previous
  31    state (blocked or unblocked) on exit.
  32
  33    A thread which wants to raise an exception in another thread (using
  34    killThread#) must block until the target thread is ready to receive
  35    it.  The action of unblocking exceptions in a thread will release all
  36    the threads waiting to deliver exceptions to that thread.
  37
  38    NB. there's a bug in here.  If a thread is inside an
  39    unsafePerformIO, and inside blockAsyncExceptions# (there is an
  40    unblockAsyncExceptions_ret on the stack), and it is blocked in an
  41    interruptible operation, and it receives an exception, then the
  42    unsafePerformIO thunk will be updated with a stack object
  43    containing the unblockAsyncExceptions_ret frame.  Later, when
  44    someone else evaluates this thunk, the blocked exception state is
  45    not restored, and the result is that unblockAsyncExceptions_ret
  46    will attempt to unblock exceptions in the current thread, but it'll
  47    find that the CurrentTSO->blocked_exceptions is NULL.  Hence, we
  48    work around this by checking for NULL in awakenBlockedQueue().
  49
  50    -------------------------------------------------------------------------- */
  51
  52 INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
  53                 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
  54 {
  55     // Not true: see comments above
  56     // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
  57 #if defined(GRAN) || defined(PAR)
  58     foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr",
  59                                    NULL "ptr");
  60 #else
  61     foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr");
  62 #endif
  63     StgTSO_blocked_exceptions(CurrentTSO) = NULL;
  64 #ifdef REG_R1
  65     Sp_adj(1);
  66     jump %ENTRY_CODE(Sp(0));
  67 #else
  68     Sp(1) = Sp(0);
  69     Sp_adj(1);
  70     jump %ENTRY_CODE(Sp(1));
  71 #endif
  72 }
  73
  74 INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret,
  75                 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
  76 {
  77     // Not true: see comments above
  78     // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) == NULL);
  79     StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
  80 #ifdef REG_R1
  81     Sp_adj(1);
  82     jump %ENTRY_CODE(Sp(0));
  83 #else
  84     Sp(1) = Sp(0);
  85     Sp_adj(1);
  86     jump %ENTRY_CODE(Sp(1));
  87 #endif
  88 }
  89
  90 blockAsyncExceptionszh_fast
  91 {
  92     /* Args: R1 :: IO a */
  93     STK_CHK_GEN( WDS(2)/* worst case */, R1_PTR, blockAsyncExceptionszh_fast);
  94
  95     if (StgTSO_blocked_exceptions(CurrentTSO) == NULL) {
  96       StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
  97       /* avoid growing the stack unnecessarily */
  98       if (Sp(0) == stg_blockAsyncExceptionszh_ret_info) {
  99         Sp_adj(1);
 100       } else {
 101         Sp_adj(-1);
 102         Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
 103       }
 104     }
 105     TICK_UNKNOWN_CALL();
 106     TICK_SLOW_CALL_v();
 107     jump stg_ap_v_fast;
 108 }
 109
 110 unblockAsyncExceptionszh_fast
 111 {
 112     /* Args: R1 :: IO a */
 113     STK_CHK_GEN( WDS(2), R1_PTR, unblockAsyncExceptionszh_fast);
 114
 115     if (StgTSO_blocked_exceptions(CurrentTSO) != NULL) {
 116 #if defined(GRAN) || defined(PAR)
 117       foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr",
 118                                      StgTSO_block_info(CurrentTSO) "ptr");
 119 #else
 120       foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr");
 121 #endif
 122       StgTSO_blocked_exceptions(CurrentTSO) = NULL;
 123
 124       /* avoid growing the stack unnecessarily */
 125       if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
 126         Sp_adj(1);
 127       } else {
 128         Sp_adj(-1);
 129         Sp(0) = stg_blockAsyncExceptionszh_ret_info;
 130       }
 131     }
 132     TICK_UNKNOWN_CALL();
 133     TICK_SLOW_CALL_v();
 134     jump stg_ap_v_fast;
 135 }
 136
 137
 138 #define interruptible(what_next)                \
 139         (   what_next == BlockedOnMVar          \
 140          || what_next == BlockedOnException     \
 141          || what_next == BlockedOnRead          \
 142          || what_next == BlockedOnWrite         \
 143          || what_next == BlockedOnDelay         \
 144          || what_next == BlockedOnDoProc)
 145
 146 killThreadzh_fast
 147 {
 148   /* args: R1 = TSO to kill, R2 = Exception */
 149
 150   W_ why_blocked;
 151
 152   /* This thread may have been relocated.
 153    * (see Schedule.c:threadStackOverflow)
 154    */
 155  while:
 156   if (StgTSO_what_next(R1) == ThreadRelocated::I16) {
 157     R1 = StgTSO_link(R1);
 158     goto while;
 159   }
 160
 161   /* Determine whether this thread is interruptible or not */
 162
 163   /* If the target thread is currently blocking async exceptions,
 164    * we'll have to block until it's ready to accept them.  The
 165    * exception is interruptible threads - ie. those that are blocked
 166    * on some resource.
 167    */
 168   why_blocked = TO_W_(StgTSO_why_blocked(R1));
 169   if (StgTSO_blocked_exceptions(R1) != NULL && !interruptible(why_blocked))
 170   {
 171       StgTSO_link(CurrentTSO) = StgTSO_blocked_exceptions(R1);
 172       StgTSO_blocked_exceptions(R1) = CurrentTSO;
 173
 174       StgTSO_why_blocked(CurrentTSO) = BlockedOnException::I16;
 175       StgTSO_block_info(CurrentTSO) = R1;
 176
 177       BLOCK( R1_PTR & R2_PTR, killThreadzh_fast );
 178   }
 179
 180   /* Killed threads turn into zombies, which might be garbage
 181    * collected at a later date.  That's why we don't have to
 182    * explicitly remove them from any queues they might be on.
 183    */
 184
 185   /* We might have killed ourselves.  In which case, better be *very*
 186    * careful.  If the exception killed us, then return to the scheduler.
 187    * If the exception went to a catch frame, we'll just continue from
 188    * the handler.
 189    */
 190   if (R1 == CurrentTSO) {
 191         SAVE_THREAD_STATE();
 192         foreign "C" raiseAsync(MyCapability() "ptr", R1 "ptr", R2 "ptr");
 193         if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
 194                 R1 = ThreadFinished;
 195                 jump StgReturn;
 196         } else {
 197                 LOAD_THREAD_STATE();
 198                 ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
 199                 jump %ENTRY_CODE(Sp(0));
 200         }
 201   } else {
 202         foreign "C" raiseAsync(MyCapability() "ptr", R1 "ptr", R2 "ptr");
 203   }
 204
 205   jump %ENTRY_CODE(Sp(0));
 206 }
 207
 208 /* -----------------------------------------------------------------------------
 209    Catch frames
 210    -------------------------------------------------------------------------- */
 211
 212 #ifdef REG_R1
 213 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret)   \
 214    label                                        \
 215    {                                            \
 216       Sp = Sp + SIZEOF_StgCatchFrame;           \
 217       jump ret;                                 \
 218    }
 219 #else
 220 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret)   \
 221    label                                        \
 222    {                                            \
 223       W_ rval;                                  \
 224       rval = Sp(0);                             \
 225       Sp = Sp + SIZEOF_StgCatchFrame;           \
 226       Sp(0) = rval;                             \
 227       jump ret;                                 \
 228    }
 229 #endif
 230
 231 #ifdef REG_R1
 232 #define SP_OFF 0
 233 #else
 234 #define SP_OFF 1
 235 #endif
 236
 237 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
 238 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
 239 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
 240 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
 241 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
 242 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
 243 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
 244 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
 245
 246 #if MAX_VECTORED_RTN > 8
 247 #error MAX_VECTORED_RTN has changed: please modify stg_catch_frame too.
 248 #endif
 249
 250 #if defined(PROFILING)
 251 #define CATCH_FRAME_BITMAP 7
 252 #define CATCH_FRAME_WORDS  4
 253 #else
 254 #define CATCH_FRAME_BITMAP 1
 255 #define CATCH_FRAME_WORDS  2
 256 #endif
 257
 258 /* Catch frames are very similar to update frames, but when entering
 259  * one we just pop the frame off the stack and perform the correct
 260  * kind of return to the activation record underneath us on the stack.
 261  */
 262
 263 INFO_TABLE_RET(stg_catch_frame,
 264                CATCH_FRAME_WORDS, CATCH_FRAME_BITMAP,
 265                CATCH_FRAME,
 266                stg_catch_frame_0_ret,
 267                stg_catch_frame_1_ret,
 268                stg_catch_frame_2_ret,
 269                stg_catch_frame_3_ret,
 270                stg_catch_frame_4_ret,
 271                stg_catch_frame_5_ret,
 272                stg_catch_frame_6_ret,
 273                stg_catch_frame_7_ret)
 274 CATCH_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
 275
 276 /* -----------------------------------------------------------------------------
 277  * The catch infotable
 278  *
 279  * This should be exactly the same as would be generated by this STG code
 280  *
 281  * catch = {x,h} \n {} -> catch#{x,h}
 282  *
 283  * It is used in deleteThread when reverting blackholes.
 284  * -------------------------------------------------------------------------- */
 285
 286 INFO_TABLE(stg_catch,2,0,FUN,"catch","catch")
 287 {
 288   R2 = StgClosure_payload(R1,1); /* h */
 289   R1 = StgClosure_payload(R1,0); /* x */
 290   jump catchzh_fast;
 291 }
 292
 293 catchzh_fast
 294 {
 295     /* args: R1 = m :: IO a, R2 = handler :: Exception -> IO a */
 296     STK_CHK_GEN(SIZEOF_StgCatchFrame + WDS(1), R1_PTR & R2_PTR, catchzh_fast);
 297
 298     /* Set up the catch frame */
 299     Sp = Sp - SIZEOF_StgCatchFrame;
 300     SET_HDR(Sp,stg_catch_frame_info,W_[CCCS]);
 301
 302     StgCatchFrame_handler(Sp) = R2;
 303     StgCatchFrame_exceptions_blocked(Sp) =
 304         (StgTSO_blocked_exceptions(CurrentTSO) != NULL);
 305     TICK_CATCHF_PUSHED();
 306
 307     /* Apply R1 to the realworld token */
 308     TICK_UNKNOWN_CALL();
 309     TICK_SLOW_CALL_v();
 310     jump stg_ap_v_fast;
 311 }
 312
 313 /* -----------------------------------------------------------------------------
 314  * The raise infotable
 315  *
 316  * This should be exactly the same as would be generated by this STG code
 317  *
 318  *   raise = {err} \n {} -> raise#{err}
 319  *
 320  * It is used in raisezh_fast to update thunks on the update list
 321  * -------------------------------------------------------------------------- */
 322
 323 INFO_TABLE(stg_raise,1,0,THUNK_1_0,"raise","raise")
 324 {
 325   R1 = StgThunk_payload(R1,0);
 326   jump raisezh_fast;
 327 }
 328
 329 raisezh_fast
 330 {
 331     W_ handler;
 332     W_ raise_closure;
 333     W_ frame_type;
 334     /* args : R1 :: Exception */
 335
 336
 337 #if defined(PROFILING)
 338     /* Debugging tool: on raising an  exception, show where we are. */
 339
 340     /* ToDo: currently this is a hack.  Would be much better if
 341      * the info was only displayed for an *uncaught* exception.
 342      */
 343     if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags)) {
 344       foreign "C" fprintCCS_stderr(W_[CCCS] "ptr");
 345     }
 346 #endif
 347
 348 retry_pop_stack:
 349     StgTSO_sp(CurrentTSO) = Sp;
 350     frame_type = foreign "C" raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", R1 "ptr");
 351     Sp = StgTSO_sp(CurrentTSO);
 352     if (frame_type == ATOMICALLY_FRAME) {
 353       /* The exception has reached the edge of a memory transaction.  Check that
 354        * the transaction is valid.  If not then perhaps the exception should
 355        * not have been thrown: re-run the transaction */
 356       W_ trec;
 357       W_ r;
 358       trec = StgTSO_trec(CurrentTSO);
 359       r = foreign "C" stmValidateNestOfTransactions(trec "ptr");
 360       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr");
 361       StgTSO_trec(CurrentTSO) = NO_TREC;
 362       if (r) {
 363         // Transaction was valid: continue searching for a catch frame
 364         Sp = Sp + SIZEOF_StgAtomicallyFrame;
 365         goto retry_pop_stack;
 366       } else {
 367         // Transaction was not valid: we retry the exception (otherwise continue
 368         // with a further call to raiseExceptionHelper)
 369         "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr");
 370         StgTSO_trec(CurrentTSO) = trec;
 371         R1 = StgAtomicallyFrame_code(Sp);
 372         jump stg_ap_v_fast;
 373       }
 374     }
 375
 376     if (frame_type == STOP_FRAME) {
 377         /*
 378          * We've stripped the entire stack, the thread is now dead.
 379          * We will leave the stack in a GC'able state, see the stg_stop_thread
 380          * entry code in StgStartup.cmm.
 381          */
 382         Sp = CurrentTSO + TSO_OFFSET_StgTSO_stack
 383                 + WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) - WDS(2);
 384         Sp(1) = R1;             /* save the exception */
 385         Sp(0) = stg_enter_info; /* so that GC can traverse this stack */
 386         StgTSO_what_next(CurrentTSO) = ThreadKilled::I16;
 387         SAVE_THREAD_STATE();    /* inline! */
 388
 389         /* The return code goes in BaseReg->rRet, and BaseReg is returned in R1 */
 390         StgRegTable_rRet(BaseReg) = ThreadFinished;
 391         R1 = BaseReg;
 392
 393         jump StgReturn;
 394     }
 395
 396     /* Ok, Sp points to the enclosing CATCH_FRAME or CATCH_STM_FRAME.  Pop everything
 397      * down to and including this frame, update Su, push R1, and enter the handler.
 398      */
 399     if (frame_type == CATCH_FRAME) {
 400       handler = StgCatchFrame_handler(Sp);
 401     } else {
 402       handler = StgCatchSTMFrame_handler(Sp);
 403     }
 404
 405     /* Restore the blocked/unblocked state for asynchronous exceptions
 406      * at the CATCH_FRAME.
 407      *
 408      * If exceptions were unblocked, arrange that they are unblocked
 409      * again after executing the handler by pushing an
 410      * unblockAsyncExceptions_ret stack frame.
 411      */
 412     W_ frame;
 413     frame = Sp;
 414     if (frame_type == CATCH_FRAME) {
 415       Sp = Sp + SIZEOF_StgCatchFrame;
 416       if (StgCatchFrame_exceptions_blocked(frame) == 0) {
 417         Sp_adj(-1);
 418         Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
 419       }
 420     } else {
 421       Sp = Sp + SIZEOF_StgCatchSTMFrame;
 422     }
 423
 424     /* Ensure that async excpetions are blocked when running the handler.
 425     */
 426     if (StgTSO_blocked_exceptions(CurrentTSO) == NULL) {
 427       StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
 428     }
 429
 430     /* Call the handler, passing the exception value and a realworld
 431      * token as arguments.
 432      */
 433     Sp_adj(-1);
 434     Sp(0) = R1;
 435     R1 = handler;
 436     Sp_adj(-1);
 437     TICK_UNKNOWN_CALL();
 438     TICK_SLOW_CALL_pv();
 439     jump RET_LBL(stg_ap_pv);
 440 }
 441
 442 raiseIOzh_fast
 443 {
 444   /* Args :: R1 :: Exception */
 445   jump raisezh_fast;
 446 }