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 = Sp + SIZEOF_StgCatchFrame;           \
 214       Sp(0) = rval;                             \
 215       jump ret;                                 \
 216    }
 217 #endif
 218
 219 #ifdef REG_R1
 220 #define SP_OFF 0
 221 #else
 222 #define SP_OFF 1
 223 #endif
 224
 225 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
 226 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
 227 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
 228 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
 229 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
 230 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
 231 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
 232 CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
 233
 234 #if MAX_VECTORED_RTN > 8
 235 #error MAX_VECTORED_RTN has changed: please modify stg_catch_frame too.
 236 #endif
 237
 238 #if defined(PROFILING)
 239 #define CATCH_FRAME_BITMAP 7
 240 #define CATCH_FRAME_WORDS  4
 241 #else
 242 #define CATCH_FRAME_BITMAP 1
 243 #define CATCH_FRAME_WORDS  2
 244 #endif
 245
 246 /* Catch frames are very similar to update frames, but when entering
 247  * one we just pop the frame off the stack and perform the correct
 248  * kind of return to the activation record underneath us on the stack.
 249  */
 250
 251 INFO_TABLE_RET(stg_catch_frame,
 252                CATCH_FRAME_WORDS, CATCH_FRAME_BITMAP,
 253                CATCH_FRAME,
 254                stg_catch_frame_0_ret,
 255                stg_catch_frame_1_ret,
 256                stg_catch_frame_2_ret,
 257                stg_catch_frame_3_ret,
 258                stg_catch_frame_4_ret,
 259                stg_catch_frame_5_ret,
 260                stg_catch_frame_6_ret,
 261                stg_catch_frame_7_ret)
 262 CATCH_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
 263
 264 /* -----------------------------------------------------------------------------
 265  * The catch infotable
 266  *
 267  * This should be exactly the same as would be generated by this STG code
 268  *
 269  * catch = {x,h} \n {} -> catch#{x,h}
 270  *
 271  * It is used in deleteThread when reverting blackholes.
 272  * -------------------------------------------------------------------------- */
 273
 274 INFO_TABLE(stg_catch,2,0,FUN,"catch","catch")
 275 {
 276   R2 = StgClosure_payload(R1,1); /* h */
 277   R1 = StgClosure_payload(R1,0); /* x */
 278   jump catchzh_fast;
 279 }
 280
 281 catchzh_fast
 282 {
 283     /* args: R1 = m :: IO a, R2 = handler :: Exception -> IO a */
 284     STK_CHK_GEN(SIZEOF_StgCatchFrame + WDS(1), R1_PTR & R2_PTR, catchzh_fast);
 285
 286     /* Set up the catch frame */
 287     Sp = Sp - SIZEOF_StgCatchFrame;
 288     SET_HDR(Sp,stg_catch_frame_info,CCCS);
 289
 290     StgCatchFrame_handler(Sp) = R2;
 291     StgCatchFrame_exceptions_blocked(Sp) =
 292         (StgTSO_blocked_exceptions(CurrentTSO) != NULL);
 293     TICK_CATCHF_PUSHED();
 294
 295     /* Apply R1 to the realworld token */
 296     Sp_adj(-1);
 297     TICK_UNKNOWN_CALL();
 298     TICK_SLOW_CALL_v();
 299     jump RET_LBL(stg_ap_v);
 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,"raise","raise")
 313 {
 314   R1 = StgClosure_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,CCCS);
 334     }
 335 #endif
 336
 337 retry_pop_stack:
 338     StgTSO_sp(CurrentTSO) = Sp;
 339     frame_type = foreign "C" raiseExceptionHelper(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" stmValidateTransaction(trec "ptr");
 349       foreign "C" stmAbortTransaction(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(NO_TREC "ptr");
 359         StgTSO_trec(CurrentTSO) = trec;
 360         R1 = StgAtomicallyFrame_code(Sp);
 361         Sp_adj(-1);
 362         jump RET_LBL(stg_ap_v);
 363       }
 364     }
 365
 366     if (frame_type == STOP_FRAME) {
 367         /* We've stripped the entire stack, the thread is now dead. */
 368         Sp = CurrentTSO + OFFSET_StgTSO_stack
 369                 + WDS(StgTSO_stack_size(CurrentTSO)) - WDS(1);
 370         Sp(0) = R1;             /* save the exception */
 371         StgTSO_what_next(CurrentTSO) = ThreadKilled::I16;
 372         SAVE_THREAD_STATE();    /* inline! */
 373         R1 = ThreadFinished;
 374         jump StgReturn;
 375     }
 376
 377     /* Ok, Sp points to the enclosing CATCH_FRAME or CATCH_STM_FRAME.  Pop everything
 378      * down to and including this frame, update Su, push R1, and enter the handler.
 379      */
 380     if (frame_type == CATCH_FRAME) {
 381       handler = StgCatchFrame_handler(Sp);
 382     } else {
 383       handler = StgCatchSTMFrame_handler(Sp);
 384     }
 385
 386     /* Restore the blocked/unblocked state for asynchronous exceptions
 387      * at the CATCH_FRAME.
 388      *
 389      * If exceptions were unblocked, arrange that they are unblocked
 390      * again after executing the handler by pushing an
 391      * unblockAsyncExceptions_ret stack frame.
 392      */
 393     W_ frame;
 394     frame = Sp;
 395     if (frame_type == CATCH_FRAME) {
 396       Sp = Sp + SIZEOF_StgCatchFrame;
 397       if (StgCatchFrame_exceptions_blocked(frame) == 0) {
 398         Sp_adj(-1);
 399         Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
 400       }
 401     } else {
 402       Sp = Sp + SIZEOF_StgCatchSTMFrame;
 403     }
 404
 405     /* Ensure that async excpetions are blocked when running the handler.
 406     */
 407     if (StgTSO_blocked_exceptions(CurrentTSO) == NULL) {
 408       StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
 409     }
 410
 411     /* Call the handler, passing the exception value and a realworld
 412      * token as arguments.
 413      */
 414     Sp_adj(-1);
 415     Sp(0) = R1;
 416     R1 = handler;
 417     Sp_adj(-1);
 418     TICK_UNKNOWN_CALL();
 419     TICK_SLOW_CALL_pv();
 420     jump RET_LBL(stg_ap_pv);
 421 }
 422
 423 raiseIOzh_fast
 424 {
 425   /* Args :: R1 :: Exception */
 426   jump raisezh_fast;
 427 }