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