fix one-character error in stack check
[ghc.git] / 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 }