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