ghc/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     Sp_adj(-1);
 106     TICK_UNKNOWN_CALL();
 107     TICK_SLOW_CALL_v();
 108     jump RET_LBL(stg_ap_v);
 109 }
 110
 111 unblockAsyncExceptionszh_fast
 112 {
 113     /* Args: R1 :: IO a */
 114     STK_CHK_GEN( WDS(2), R1_PTR, unblockAsyncExceptionszh_fast);
 115
 116     if (StgTSO_blocked_exceptions(CurrentTSO) != NULL) {
 117 #if defined(GRAN) || defined(PAR)
 118       foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr",
 119                                      StgTSO_block_info(CurrentTSO) "ptr");
 120 #else
 121       foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr");
 122 #endif
 123       StgTSO_blocked_exceptions(CurrentTSO) = NULL;
 124
 125       /* avoid growing the stack unnecessarily */
 126       if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
 127         Sp_adj(1);
 128       } else {
 129         Sp_adj(-1);
 130         Sp(0) = stg_blockAsyncExceptionszh_ret_info;
 131       }
 132     }
 133     Sp_adj(-1);
 134     TICK_UNKNOWN_CALL();
 135     TICK_SLOW_CALL_v();
 136     jump RET_LBL(stg_ap_v);
 137 }
 138
 139
 140 #define interruptible(what_next)                \
 141         (   what_next == BlockedOnMVar          \
 142          || what_next == BlockedOnException     \
 143          || what_next == BlockedOnRead          \
 144          || what_next == BlockedOnWrite         \
 145          || what_next == BlockedOnDelay         \
 146          || what_next == BlockedOnDoProc)
 147
 148 killThreadzh_fast
 149 {
 150   /* args: R1 = TSO to kill, R2 = Exception */
 151
 152   W_ why_blocked;
 153
 154   /* This thread may have been relocated.
 155    * (see Schedule.c:threadStackOverflow)
 156    */
 157  while:
 158   if (StgTSO_what_next(R1) == ThreadRelocated::I16) {
 159     R1 = StgTSO_link(R1);
 160     goto while;
 161   }
 162
 163   /* Determine whether this thread is interruptible or not */
 164
 165   /* If the target thread is currently blocking async exceptions,
 166    * we'll have to block until it's ready to accept them.  The
 167    * exception is interruptible threads - ie. those that are blocked
 168    * on some resource.
 169    */
 170   why_blocked = TO_W_(StgTSO_why_blocked(R1));
 171   if (StgTSO_blocked_exceptions(R1) != NULL && !interruptible(why_blocked))
 172   {
 173       StgTSO_link(CurrentTSO) = StgTSO_blocked_exceptions(R1);
 174       StgTSO_blocked_exceptions(R1) = CurrentTSO;
 175
 176       StgTSO_why_blocked(CurrentTSO) = BlockedOnException::I16;
 177       StgTSO_block_info(CurrentTSO) = R1;
 178
 179       BLOCK( R1_PTR & R2_PTR, killThreadzh_fast );
 180   }
 181
 182   /* Killed threads turn into zombies, which might be garbage
 183    * collected at a later date.  That's why we don't have to
 184    * explicitly remove them from any queues they might be on.
 185    */
 186
 187   /* We might have killed ourselves.  In which case, better be *very*
 188    * careful.  If the exception killed us, then return to the scheduler.
 189    * If the exception went to a catch frame, we'll just continue from
 190    * the handler.
 191    */
 192   if (R1 == CurrentTSO) {
 193         SAVE_THREAD_STATE();
 194         foreign "C" raiseAsync(MyCapability() "ptr", R1 "ptr", R2 "ptr");
 195         if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
 196                 R1 = ThreadFinished;
 197                 jump StgReturn;
 198         } else {
 199                 LOAD_THREAD_STATE();
 200                 ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
 201                 jump %ENTRY_CODE(Sp(0));
 202         }
 203   } else {
 204         foreign "C" raiseAsync(MyCapability() "ptr", R1 "ptr", R2 "ptr");
 205   }
 206
 207   jump %ENTRY_CODE(Sp(0));
 208 }
 209
 210 /* -----------------------------------------------------------------------------
 211    Catch frames
 212    -------------------------------------------------------------------------- */
 213
 214 #ifdef REG_R1
 215 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret)   \
 216    label                                        \
 217    {                                            \
 218       Sp = Sp + SIZEOF_StgCatchFrame;           \
 219       jump ret;                                 \
 220    }
 221 #else
 222 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret)   \
 223    label                                        \
 224    {                                            \
 225       W_ rval;                                  \
 226       rval = Sp(0);                             \
 227       Sp = Sp + SIZEOF_StgCatchFrame;           \
 228       Sp(0) = rval;                             \
 229       jump ret;                                 \
 230    }
 231 #endif
 232
 233 #ifdef REG_R1
 234 #define SP_OFF 0
 235 #else
 236 #define SP_OFF 1
 237 #endif
 238
 239 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
 240 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
 241 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
 242 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
 243 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
 244 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
 245 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
 246 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
 247
 248 #if MAX_VECTORED_RTN > 8
 249 #error MAX_VECTORED_RTN has changed: please modify stg_catch_frame too.
 250 #endif
 251
 252 #if defined(PROFILING)
 253 #define CATCH_FRAME_BITMAP 7
 254 #define CATCH_FRAME_WORDS  4
 255 #else
 256 #define CATCH_FRAME_BITMAP 1
 257 #define CATCH_FRAME_WORDS  2
 258 #endif
 259
 260 /* Catch frames are very similar to update frames, but when entering
 261  * one we just pop the frame off the stack and perform the correct
 262  * kind of return to the activation record underneath us on the stack.
 263  */
 264
 265 INFO_TABLE_RET(stg_catch_frame,
 266                CATCH_FRAME_WORDS, CATCH_FRAME_BITMAP,
 267                CATCH_FRAME,
 268                stg_catch_frame_0_ret,
 269                stg_catch_frame_1_ret,
 270                stg_catch_frame_2_ret,
 271                stg_catch_frame_3_ret,
 272                stg_catch_frame_4_ret,
 273                stg_catch_frame_5_ret,
 274                stg_catch_frame_6_ret,
 275                stg_catch_frame_7_ret)
 276 CATCH_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
 277
 278 /* -----------------------------------------------------------------------------
 279  * The catch infotable
 280  *
 281  * This should be exactly the same as would be generated by this STG code
 282  *
 283  * catch = {x,h} \n {} -> catch#{x,h}
 284  *
 285  * It is used in deleteThread when reverting blackholes.
 286  * -------------------------------------------------------------------------- */
 287
 288 INFO_TABLE(stg_catch,2,0,FUN,"catch","catch")
 289 {
 290   R2 = StgClosure_payload(R1,1); /* h */
 291   R1 = StgClosure_payload(R1,0); /* x */
 292   jump catchzh_fast;
 293 }
 294
 295 catchzh_fast
 296 {
 297     /* args: R1 = m :: IO a, R2 = handler :: Exception -> IO a */
 298     STK_CHK_GEN(SIZEOF_StgCatchFrame + WDS(1), R1_PTR & R2_PTR, catchzh_fast);
 299
 300     /* Set up the catch frame */
 301     Sp = Sp - SIZEOF_StgCatchFrame;
 302     SET_HDR(Sp,stg_catch_frame_info,W_[CCCS]);
 303
 304     StgCatchFrame_handler(Sp) = R2;
 305     StgCatchFrame_exceptions_blocked(Sp) =
 306         (StgTSO_blocked_exceptions(CurrentTSO) != NULL);
 307     TICK_CATCHF_PUSHED();
 308
 309     /* Apply R1 to the realworld token */
 310     Sp_adj(-1);
 311     TICK_UNKNOWN_CALL();
 312     TICK_SLOW_CALL_v();
 313     jump RET_LBL(stg_ap_v);
 314 }
 315
 316 /* -----------------------------------------------------------------------------
 317  * The raise infotable
 318  *
 319  * This should be exactly the same as would be generated by this STG code
 320  *
 321  *   raise = {err} \n {} -> raise#{err}
 322  *
 323  * It is used in raisezh_fast to update thunks on the update list
 324  * -------------------------------------------------------------------------- */
 325
 326 INFO_TABLE(stg_raise,1,0,THUNK_1_0,"raise","raise")
 327 {
 328   R1 = StgThunk_payload(R1,0);
 329   jump raisezh_fast;
 330 }
 331
 332 raisezh_fast
 333 {
 334     W_ handler;
 335     W_ raise_closure;
 336     W_ frame_type;
 337     /* args : R1 :: Exception */
 338
 339
 340 #if defined(PROFILING)
 341     /* Debugging tool: on raising an  exception, show where we are. */
 342
 343     /* ToDo: currently this is a hack.  Would be much better if
 344      * the info was only displayed for an *uncaught* exception.
 345      */
 346     if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags)) {
 347       foreign "C" fprintCCS_stderr(W_[CCCS] "ptr");
 348     }
 349 #endif
 350
 351 retry_pop_stack:
 352     StgTSO_sp(CurrentTSO) = Sp;
 353     frame_type = foreign "C" raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", R1 "ptr");
 354     Sp = StgTSO_sp(CurrentTSO);
 355     if (frame_type == ATOMICALLY_FRAME) {
 356       /* The exception has reached the edge of a memory transaction.  Check that
 357        * the transaction is valid.  If not then perhaps the exception should
 358        * not have been thrown: re-run the transaction */
 359       W_ trec;
 360       W_ r;
 361       trec = StgTSO_trec(CurrentTSO);
 362       r = foreign "C" stmValidateNestOfTransactions(trec "ptr");
 363       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr");
 364       StgTSO_trec(CurrentTSO) = NO_TREC;
 365       if (r) {
 366         // Transaction was valid: continue searching for a catch frame
 367         Sp = Sp + SIZEOF_StgAtomicallyFrame;
 368         goto retry_pop_stack;
 369       } else {
 370         // Transaction was not valid: we retry the exception (otherwise continue
 371         // with a further call to raiseExceptionHelper)
 372         "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr");
 373         StgTSO_trec(CurrentTSO) = trec;
 374         R1 = StgAtomicallyFrame_code(Sp);
 375         Sp_adj(-1);
 376         jump RET_LBL(stg_ap_v);
 377       }
 378     }
 379
 380     if (frame_type == STOP_FRAME) {
 381         /*
 382          * We've stripped the entire stack, the thread is now dead.
 383          * We will leave the stack in a GC'able state, see the stg_stop_thread
 384          * entry code in StgStartup.cmm.
 385          */
 386         Sp = CurrentTSO + TSO_OFFSET_StgTSO_stack
 387                 + WDS(StgTSO_stack_size(CurrentTSO)) - WDS(2);
 388         Sp(1) = R1;             /* save the exception */
 389         Sp(0) = stg_enter_info; /* so that GC can traverse this stack */
 390         StgTSO_what_next(CurrentTSO) = ThreadKilled::I16;
 391         SAVE_THREAD_STATE();    /* inline! */
 392
 393         /* The return code goes in BaseReg->rRet, and BaseReg is returned in R1 */
 394         StgRegTable_rRet(BaseReg) = ThreadFinished;
 395         R1 = BaseReg;
 396
 397         jump StgReturn;
 398     }
 399
 400     /* Ok, Sp points to the enclosing CATCH_FRAME or CATCH_STM_FRAME.  Pop everything
 401      * down to and including this frame, update Su, push R1, and enter the handler.
 402      */
 403     if (frame_type == CATCH_FRAME) {
 404       handler = StgCatchFrame_handler(Sp);
 405     } else {
 406       handler = StgCatchSTMFrame_handler(Sp);
 407     }
 408
 409     /* Restore the blocked/unblocked state for asynchronous exceptions
 410      * at the CATCH_FRAME.
 411      *
 412      * If exceptions were unblocked, arrange that they are unblocked
 413      * again after executing the handler by pushing an
 414      * unblockAsyncExceptions_ret stack frame.
 415      */
 416     W_ frame;
 417     frame = Sp;
 418     if (frame_type == CATCH_FRAME) {
 419       Sp = Sp + SIZEOF_StgCatchFrame;
 420       if (StgCatchFrame_exceptions_blocked(frame) == 0) {
 421         Sp_adj(-1);
 422         Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
 423       }
 424     } else {
 425       Sp = Sp + SIZEOF_StgCatchSTMFrame;
 426     }
 427
 428     /* Ensure that async excpetions are blocked when running the handler.
 429     */
 430     if (StgTSO_blocked_exceptions(CurrentTSO) == NULL) {
 431       StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
 432     }
 433
 434     /* Call the handler, passing the exception value and a realworld
 435      * token as arguments.
 436      */
 437     Sp_adj(-1);
 438     Sp(0) = R1;
 439     R1 = handler;
 440     Sp_adj(-1);
 441     TICK_UNKNOWN_CALL();
 442     TICK_SLOW_CALL_pv();
 443     jump RET_LBL(stg_ap_pv);
 444 }
 445
 446 raiseIOzh_fast
 447 {
 448   /* Args :: R1 :: Exception */
 449   jump raisezh_fast;
 450 }