1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
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.
11 * ---------------------------------------------------------------------------*/
15 /* -----------------------------------------------------------------------------
18 A thread can request that asynchronous exceptions not be delivered
19 ("blocked") for the duration of an I/O computation. The primitive
21 blockAsyncExceptions# :: IO a -> IO a
23 is used for this purpose. During a blocked section, asynchronous
24 exceptions may be unblocked again temporarily:
26 unblockAsyncExceptions# :: IO a -> IO a
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.
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.
38 -------------------------------------------------------------------------- */
40 INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
41 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
43 ASSERT(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
44 #if defined(GRAN) || defined(PAR)
45 foreign "C" awakenBlockedQueue(StgTSO_blocked_exceptions(CurrentTSO) "ptr",
48 foreign "C" awakenBlockedQueue(StgTSO_blocked_exceptions(CurrentTSO) "ptr");
50 StgTSO_blocked_exceptions(CurrentTSO) = NULL;
53 jump %ENTRY_CODE(Sp(0));
57 jump %ENTRY_CODE(Sp(1));
61 INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret,
62 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
64 ASSERT(StgTSO_blocked_exceptions(CurrentTSO) == NULL);
65 StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
68 jump %ENTRY_CODE(Sp(0));
72 jump %ENTRY_CODE(Sp(1));
76 blockAsyncExceptionszh_fast
78 /* Args: R1 :: IO a */
79 STK_CHK_GEN( WDS(2)/* worst case */, R1_PTR, blockAsyncExceptionszh_fast);
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) {
88 Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
94 jump RET_LBL(stg_ap_v);
97 unblockAsyncExceptionszh_fast
99 /* Args: R1 :: IO a */
100 STK_CHK_GEN( WDS(2), R1_PTR, unblockAsyncExceptionszh_fast);
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");
107 foreign "C" awakenBlockedQueue(StgTSO_blocked_exceptions(CurrentTSO) "ptr");
109 StgTSO_blocked_exceptions(CurrentTSO) = NULL;
111 /* avoid growing the stack unnecessarily */
112 if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
116 Sp(0) = stg_blockAsyncExceptionszh_ret_info;
122 jump RET_LBL(stg_ap_v);
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)
136 /* args: R1 = TSO to kill, R2 = Exception */
140 /* This thread may have been relocated.
141 * (see Schedule.c:threadStackOverflow)
144 if (StgTSO_what_next(R1) == ThreadRelocated::I16) {
145 R1 = StgTSO_link(R1);
149 /* Determine whether this thread is interruptible or not */
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
156 why_blocked = TO_W_(StgTSO_why_blocked(R1));
157 if (StgTSO_blocked_exceptions(R1) != NULL && !interruptible(why_blocked))
159 StgTSO_link(CurrentTSO) = StgTSO_blocked_exceptions(R1);
160 StgTSO_blocked_exceptions(R1) = CurrentTSO;
162 StgTSO_why_blocked(CurrentTSO) = BlockedOnException::I16;
163 StgTSO_block_info(CurrentTSO) = R1;
165 BLOCK( R1_PTR & R2_PTR, killThreadzh_fast );
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.
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
178 if (R1 == CurrentTSO) {
180 foreign "C" raiseAsyncWithLock(R1 "ptr", R2 "ptr");
181 if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
186 ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
187 jump %ENTRY_CODE(Sp(0));
190 foreign "C" raiseAsyncWithLock(R1 "ptr", R2 "ptr");
193 jump %ENTRY_CODE(Sp(0));
196 /* -----------------------------------------------------------------------------
198 -------------------------------------------------------------------------- */
201 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
204 Sp = Sp + SIZEOF_StgCatchFrame; \
208 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
214 Sp = Sp + SIZEOF_StgCatchFrame - WDS(1); \
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))
235 #if MAX_VECTORED_RTN > 8
236 #error MAX_VECTORED_RTN has changed: please modify stg_catch_frame too.
239 #if defined(PROFILING)
240 #define CATCH_FRAME_BITMAP 7
241 #define CATCH_FRAME_WORDS 4
243 #define CATCH_FRAME_BITMAP 1
244 #define CATCH_FRAME_WORDS 2
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.
252 INFO_TABLE_RET(stg_catch_frame,
253 CATCH_FRAME_WORDS, CATCH_FRAME_BITMAP,
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)))
265 /* -----------------------------------------------------------------------------
266 * The catch infotable
268 * This should be exactly the same as would be generated by this STG code
270 * catch = {x,h} \n {} -> catch#{x,h}
272 * It is used in deleteThread when reverting blackholes.
273 * -------------------------------------------------------------------------- */
275 INFO_TABLE(stg_catch,2,0,FUN,"catch","catch")
277 R2 = StgClosure_payload(R1,1); /* h */
278 R1 = StgClosure_payload(R1,0); /* x */
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);
287 /* Set up the catch frame */
288 Sp = Sp - SIZEOF_StgCatchFrame;
289 SET_HDR(Sp,stg_catch_frame_info,CCCS);
291 StgCatchFrame_handler(Sp) = R2;
292 StgCatchFrame_exceptions_blocked(Sp) =
293 (StgTSO_blocked_exceptions(CurrentTSO) != NULL);
294 TICK_CATCHF_PUSHED();
296 /* Apply R1 to the realworld token */
300 jump RET_LBL(stg_ap_v);
303 /* -----------------------------------------------------------------------------
304 * The raise infotable
306 * This should be exactly the same as would be generated by this STG code
308 * raise = {err} \n {} -> raise#{err}
310 * It is used in raisezh_fast to update thunks on the update list
311 * -------------------------------------------------------------------------- */
313 INFO_TABLE(stg_raise,1,0,THUNK,"raise","raise")
315 R1 = StgClosure_payload(R1,0);
324 /* args : R1 :: Exception */
327 #if defined(PROFILING)
328 /* Debugging tool: on raising an exception, show where we are. */
330 /* ToDo: currently this is a hack. Would be much better if
331 * the info was only displayed for an *uncaught* exception.
333 if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags)) {
334 foreign "C" fprintCCS(stderr,CCCS);
338 StgTSO_sp(CurrentTSO) = Sp;
339 frame_type = foreign "C" raiseExceptionHelper(CurrentTSO "ptr", R1 "ptr");
340 Sp = StgTSO_sp(CurrentTSO);
342 if (frame_type == STOP_FRAME) {
343 /* We've stripped the entire stack, the thread is now dead. */
344 Sp = CurrentTSO + OFFSET_StgTSO_stack
345 + WDS(StgTSO_stack_size(CurrentTSO)) - WDS(1);
346 Sp(0) = R1; /* save the exception */
347 StgTSO_what_next(CurrentTSO) = ThreadKilled::I16;
348 SAVE_THREAD_STATE(); /* inline! */
353 /* Ok, Sp points to the enclosing CATCH_FRAME. Pop everything down to
354 * and including this frame, update Su, push R1, and enter the handler.
356 handler = StgCatchFrame_handler(Sp);
358 /* Restore the blocked/unblocked state for asynchronous exceptions
359 * at the CATCH_FRAME.
361 * If exceptions were unblocked, arrange that they are unblocked
362 * again after executing the handler by pushing an
363 * unblockAsyncExceptions_ret stack frame.
367 Sp = Sp + SIZEOF_StgCatchFrame;
369 if (StgCatchFrame_exceptions_blocked(frame) == 0) {
371 Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
374 /* Ensure that async excpetions are blocked when running the handler.
376 if (StgTSO_blocked_exceptions(CurrentTSO) == NULL) {
377 StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
380 /* Call the handler, passing the exception value and a realworld
381 * token as arguments.
389 jump RET_LBL(stg_ap_pv);
394 /* Args :: R1 :: Exception */