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