Fix #3429: a tricky race condition
[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 import ghczmprim_GHCziBool_True_closure;
17
18 /* -----------------------------------------------------------------------------
19    Exception Primitives
20
21    A thread can request that asynchronous exceptions not be delivered
22    ("blocked") for the duration of an I/O computation.  The primitive
23    
24         blockAsyncExceptions# :: IO a -> IO a
25
26    is used for this purpose.  During a blocked section, asynchronous
27    exceptions may be unblocked again temporarily:
28
29         unblockAsyncExceptions# :: IO a -> IO a
30
31    Furthermore, asynchronous exceptions are blocked automatically during
32    the execution of an exception handler.  Both of these primitives
33    leave a continuation on the stack which reverts to the previous
34    state (blocked or unblocked) on exit.
35
36    A thread which wants to raise an exception in another thread (using
37    killThread#) must block until the target thread is ready to receive
38    it.  The action of unblocking exceptions in a thread will release all
39    the threads waiting to deliver exceptions to that thread.
40
41    NB. there's a bug in here.  If a thread is inside an
42    unsafePerformIO, and inside blockAsyncExceptions# (there is an
43    unblockAsyncExceptions_ret on the stack), and it is blocked in an
44    interruptible operation, and it receives an exception, then the
45    unsafePerformIO thunk will be updated with a stack object
46    containing the unblockAsyncExceptions_ret frame.  Later, when
47    someone else evaluates this thunk, the blocked exception state is
48    not restored.
49
50    -------------------------------------------------------------------------- */
51
52 STRING(stg_unblockAsync_err_str, "unblockAsyncExceptions#_ret")
53
54 INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
55 {
56     CInt r;
57
58     StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
59         ~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
60
61     /* Eagerly raise a blocked exception, if there is one */
62     if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
63         /* 
64          * We have to be very careful here, as in killThread#, since
65          * we are about to raise an async exception in the current
66          * thread, which might result in the thread being killed.
67          */
68
69         STK_CHK_GEN( WDS(2), R1_PTR, stg_unblockAsyncExceptionszh_ret_info);
70         Sp_adj(-2);
71         Sp(1) = R1;
72         Sp(0) = stg_gc_unpt_r1_info;
73         SAVE_THREAD_STATE();
74         (r) = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
75                                                       CurrentTSO "ptr") [R1];
76
77         if (r != 0::CInt) {
78             if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
79                 jump stg_threadFinished;
80             } else {
81                 LOAD_THREAD_STATE();
82                 ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
83                 jump %ENTRY_CODE(Sp(0));
84             }
85         }
86         else {
87             /*
88                the thread might have been removed from the
89                blocked_exception list by someone else in the meantime.
90                Just restore the stack pointer and continue.  
91             */   
92             Sp_adj(2);
93         }
94     }
95
96     Sp_adj(1);
97     jump %ENTRY_CODE(Sp(0));
98 }
99
100 INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret, RET_SMALL )
101 {
102     StgTSO_flags(CurrentTSO) = 
103         StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
104
105     Sp_adj(1);
106     jump %ENTRY_CODE(Sp(0));
107 }
108
109 stg_blockAsyncExceptionszh
110 {
111     /* Args: R1 :: IO a */
112     STK_CHK_GEN( WDS(2)/* worst case */, R1_PTR, stg_blockAsyncExceptionszh);
113
114     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
115         
116         StgTSO_flags(CurrentTSO) = 
117            StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
118
119         /* avoid growing the stack unnecessarily */
120         if (Sp(0) == stg_blockAsyncExceptionszh_ret_info) {
121             Sp_adj(1);
122         } else {
123             Sp_adj(-1);
124             Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
125         }
126     }
127     TICK_UNKNOWN_CALL();
128     TICK_SLOW_CALL_v();
129     jump stg_ap_v_fast;
130 }
131
132 stg_unblockAsyncExceptionszh
133 {
134     CInt r;
135
136     /* Args: R1 :: IO a */
137     STK_CHK_GEN( WDS(4), R1_PTR, stg_unblockAsyncExceptionszh);
138     /* 4 words: one for the unblock frame, 3 for setting up the
139      * stack to call maybePerformBlockedException() below.
140      */
141
142     /* If exceptions are already unblocked, there's nothing to do */
143     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) {
144
145         StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
146            ~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
147
148         /* avoid growing the stack unnecessarily */
149         if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
150             Sp_adj(1);
151         } else {
152             Sp_adj(-1);
153             Sp(0) = stg_blockAsyncExceptionszh_ret_info;
154         }
155
156         /* Eagerly raise a blocked exception, if there is one */
157         if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
158             /* 
159              * We have to be very careful here, as in killThread#, since
160              * we are about to raise an async exception in the current
161              * thread, which might result in the thread being killed.
162              *
163              * Now, if we are to raise an exception in the current
164              * thread, there might be an update frame above us on the
165              * stack due to unsafePerformIO.  Hence, the stack must
166              * make sense, because it is about to be snapshotted into
167              * an AP_STACK.
168              */
169             Sp_adj(-3);
170             Sp(2) = stg_ap_v_info;
171             Sp(1) = R1;
172             Sp(0) = stg_enter_info;
173
174             SAVE_THREAD_STATE();
175             (r) = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
176                                                       CurrentTSO "ptr") [R1];
177
178             if (r != 0::CInt) {
179                 if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
180                     jump stg_threadFinished;
181                 } else {
182                     LOAD_THREAD_STATE();
183                     ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
184                     jump %ENTRY_CODE(Sp(0));
185                 }
186             } else {
187                 /* we'll just call R1 directly, below */
188                 Sp_adj(3);
189             }
190         }
191
192     }
193     TICK_UNKNOWN_CALL();
194     TICK_SLOW_CALL_v();
195     jump stg_ap_v_fast;
196 }
197
198 stg_asyncExceptionsBlockedzh
199 {
200     /* args: none */
201     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) {
202         RET_N(1);
203     } else {
204         RET_N(0);
205     }
206 }
207
208 stg_killThreadzh
209 {
210     /* args: R1 = TSO to kill, R2 = Exception */
211
212     W_ why_blocked;
213     W_ target;
214     W_ exception;
215     
216     target = R1;
217     exception = R2;
218     
219     /* Needs 3 words because throwToSingleThreaded uses some stack */
220     STK_CHK_GEN( WDS(3), R1_PTR & R2_PTR, stg_killThreadzh);
221
222     /* 
223      * We might have killed ourselves.  In which case, better be *very*
224      * careful.  If the exception killed us, then return to the scheduler.
225      * If the exception went to a catch frame, we'll just continue from
226      * the handler.
227      */
228   loop:
229     if (StgTSO_what_next(target) == ThreadRelocated::I16) {
230         target = StgTSO__link(target);
231         goto loop;
232     }
233     if (target == CurrentTSO) {
234         /*
235          * So what should happen if a thread calls "throwTo self" inside
236          * unsafePerformIO, and later the closure is evaluated by another
237          * thread?  Presumably it should behave as if throwTo just returned,
238          * and then continue from there.  See #3279, #3288.  This is what
239          * happens: on resumption, we will just jump to the next frame on
240          * the stack, which is the return point for stg_killThreadzh.
241          */
242         SAVE_THREAD_STATE();
243         /* ToDo: what if the current thread is blocking exceptions? */
244         foreign "C" throwToSingleThreaded(MyCapability() "ptr", 
245                                           target "ptr", exception "ptr")[R1,R2];
246         if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
247             jump stg_threadFinished;
248         } else {
249             LOAD_THREAD_STATE();
250             ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
251             jump %ENTRY_CODE(Sp(0));
252         }
253     } else {
254         W_ out;
255         W_ retcode;
256         out = Sp - WDS(1); /* ok to re-use stack space here */
257
258         (retcode) = foreign "C" throwTo(MyCapability() "ptr",
259                                       CurrentTSO "ptr",
260                                       target "ptr",
261                                       exception "ptr",
262                                       out "ptr") [R1,R2];
263         
264         switch [THROWTO_SUCCESS .. THROWTO_BLOCKED] (retcode) {
265
266         case THROWTO_SUCCESS: {
267             jump %ENTRY_CODE(Sp(0));
268         }
269
270         case THROWTO_BLOCKED: {
271             R3 = W_[out];
272             // we must block, and call throwToReleaseTarget() before returning
273             jump stg_block_throwto;
274         }
275         }
276     }
277 }
278
279 /* -----------------------------------------------------------------------------
280    Catch frames
281    -------------------------------------------------------------------------- */
282
283 #define SP_OFF 0
284
285 /* Catch frames are very similar to update frames, but when entering
286  * one we just pop the frame off the stack and perform the correct
287  * kind of return to the activation record underneath us on the stack.
288  */
289
290 INFO_TABLE_RET(stg_catch_frame, CATCH_FRAME,
291 #if defined(PROFILING)
292   W_ unused1, W_ unused2,
293 #endif
294   W_ unused3, P_ unused4)
295    {
296       Sp = Sp + SIZEOF_StgCatchFrame;
297       jump %ENTRY_CODE(Sp(SP_OFF));
298    }
299
300 /* -----------------------------------------------------------------------------
301  * The catch infotable
302  *
303  * This should be exactly the same as would be generated by this STG code
304  *
305  * catch = {x,h} \n {} -> catch#{x,h}
306  *
307  * It is used in deleteThread when reverting blackholes.
308  * -------------------------------------------------------------------------- */
309
310 INFO_TABLE(stg_catch,2,0,FUN,"catch","catch")
311 {
312   R2 = StgClosure_payload(R1,1); /* h */
313   R1 = StgClosure_payload(R1,0); /* x */
314   jump stg_catchzh;
315 }
316
317 stg_catchzh
318 {
319     /* args: R1 = m :: IO a, R2 = handler :: Exception -> IO a */
320     STK_CHK_GEN(SIZEOF_StgCatchFrame + WDS(1), R1_PTR & R2_PTR, stg_catchzh);
321   
322     /* Set up the catch frame */
323     Sp = Sp - SIZEOF_StgCatchFrame;
324     SET_HDR(Sp,stg_catch_frame_info,W_[CCCS]);
325     
326     StgCatchFrame_handler(Sp) = R2;
327     StgCatchFrame_exceptions_blocked(Sp) = TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX;
328     TICK_CATCHF_PUSHED();
329
330     /* Apply R1 to the realworld token */
331     TICK_UNKNOWN_CALL();
332     TICK_SLOW_CALL_v();
333     jump stg_ap_v_fast;
334 }
335
336 /* -----------------------------------------------------------------------------
337  * The raise infotable
338  * 
339  * This should be exactly the same as would be generated by this STG code
340  *
341  *   raise = {err} \n {} -> raise#{err}
342  *
343  * It is used in stg_raisezh to update thunks on the update list
344  * -------------------------------------------------------------------------- */
345
346 INFO_TABLE(stg_raise,1,0,THUNK_1_0,"raise","raise")
347 {
348   R1 = StgThunk_payload(R1,0);
349   jump stg_raisezh;
350 }
351
352 section "data" {
353   no_break_on_exception: W_[1];
354 }
355
356 INFO_TABLE_RET(stg_raise_ret, RET_SMALL, P_ arg1)
357 {
358   R1 = Sp(1);
359   Sp = Sp + WDS(2);
360   W_[no_break_on_exception] = 1;  
361   jump stg_raisezh;
362 }
363
364 stg_raisezh
365 {
366     W_ handler;
367     W_ frame_type;
368     W_ exception;
369     /* args : R1 :: Exception */
370
371    exception = R1;
372
373 #if defined(PROFILING)
374     /* Debugging tool: on raising an  exception, show where we are. */
375
376     /* ToDo: currently this is a hack.  Would be much better if
377      * the info was only displayed for an *uncaught* exception.
378      */
379     if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags) != 0::I32) {
380       foreign "C" fprintCCS_stderr(W_[CCCS] "ptr") [];
381     }
382 #endif
383     
384 retry_pop_stack:
385     StgTSO_sp(CurrentTSO) = Sp;
386     (frame_type) = foreign "C" raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", exception "ptr") [];
387     Sp = StgTSO_sp(CurrentTSO);
388     if (frame_type == ATOMICALLY_FRAME) {
389       /* The exception has reached the edge of a memory transaction.  Check that 
390        * the transaction is valid.  If not then perhaps the exception should
391        * not have been thrown: re-run the transaction.  "trec" will either be
392        * a top-level transaction running the atomic block, or a nested 
393        * transaction running an invariant check.  In the latter case we
394        * abort and de-allocate the top-level transaction that encloses it
395        * as well (we could just abandon its transaction record, but this makes
396        * sure it's marked as aborted and available for re-use). */
397       W_ trec, outer;
398       W_ r;
399       trec = StgTSO_trec(CurrentTSO);
400       (r) = foreign "C" stmValidateNestOfTransactions(trec "ptr") [];
401       ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
402       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
403       foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr") [];
404
405       if (outer != NO_TREC) {
406         foreign "C" stmAbortTransaction(MyCapability() "ptr", outer "ptr") [];
407         foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", outer "ptr") [];
408       }
409
410       StgTSO_trec(CurrentTSO) = NO_TREC;
411       if (r != 0) {
412         // Transaction was valid: continue searching for a catch frame
413         Sp = Sp + SIZEOF_StgAtomicallyFrame;
414         goto retry_pop_stack;
415       } else {
416         // Transaction was not valid: we retry the exception (otherwise continue
417         // with a further call to raiseExceptionHelper)
418         ("ptr" trec) = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr") [];
419         StgTSO_trec(CurrentTSO) = trec;
420         R1 = StgAtomicallyFrame_code(Sp);
421         jump stg_ap_v_fast;
422       }          
423     }
424
425     // After stripping the stack, see whether we should break here for
426     // GHCi (c.f. the -fbreak-on-exception flag).  We do this after
427     // stripping the stack for a reason: we'll be inspecting values in
428     // GHCi, and it helps if all the thunks under evaluation have
429     // already been updated with the exception, rather than being left
430     // as blackholes.
431     if (W_[no_break_on_exception] != 0) {
432         W_[no_break_on_exception] = 0;
433     } else {
434         if (TO_W_(CInt[rts_stop_on_exception]) != 0) {
435             W_ ioAction;
436             // we don't want any further exceptions to be caught,
437             // until GHCi is ready to handle them.  This prevents
438             // deadlock if an exception is raised in InteractiveUI,
439             // for exmplae.  Perhaps the stop_on_exception flag should
440             // be per-thread.
441             CInt[rts_stop_on_exception] = 0;
442             ("ptr" ioAction) = foreign "C" deRefStablePtr (W_[rts_breakpoint_io_action] "ptr") [];
443             Sp = Sp - WDS(7);
444             Sp(6) = exception;
445             Sp(5) = stg_raise_ret_info;
446             Sp(4) = stg_noforceIO_info;    // required for unregisterised
447             Sp(3) = exception;             // the AP_STACK
448             Sp(2) = ghczmprim_GHCziBool_True_closure; // dummy breakpoint info
449             Sp(1) = ghczmprim_GHCziBool_True_closure; // True <=> a breakpoint
450             R1 = ioAction;
451             jump RET_LBL(stg_ap_pppv);
452         }
453     }
454
455     if (frame_type == STOP_FRAME) {
456         /*
457          * We've stripped the entire stack, the thread is now dead.
458          * We will leave the stack in a GC'able state, see the stg_stop_thread
459          * entry code in StgStartup.cmm.
460          */
461         Sp = CurrentTSO + TSO_OFFSET_StgTSO_stack 
462                 + WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) - WDS(2);
463         Sp(1) = exception;      /* save the exception */
464         Sp(0) = stg_enter_info; /* so that GC can traverse this stack */
465         StgTSO_what_next(CurrentTSO) = ThreadKilled::I16;
466         SAVE_THREAD_STATE();    /* inline! */
467
468         jump stg_threadFinished;
469     }
470
471     /* Ok, Sp points to the enclosing CATCH_FRAME or CATCH_STM_FRAME.  Pop everything
472      * down to and including this frame, update Su, push R1, and enter the handler.
473      */
474     if (frame_type == CATCH_FRAME) {
475       handler = StgCatchFrame_handler(Sp);
476     } else {
477       handler = StgCatchSTMFrame_handler(Sp);
478     }
479
480     /* Restore the blocked/unblocked state for asynchronous exceptions
481      * at the CATCH_FRAME.  
482      *
483      * If exceptions were unblocked, arrange that they are unblocked
484      * again after executing the handler by pushing an
485      * unblockAsyncExceptions_ret stack frame.
486      *
487      * If we've reached an STM catch frame then roll back the nested
488      * transaction we were using.
489      */
490     W_ frame;
491     frame = Sp;
492     if (frame_type == CATCH_FRAME) {
493       Sp = Sp + SIZEOF_StgCatchFrame;
494       if (StgCatchFrame_exceptions_blocked(frame) == 0) {
495         Sp_adj(-1);
496         Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
497       }
498     } else {
499       W_ trec, outer;
500       trec = StgTSO_trec(CurrentTSO);
501       ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
502       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
503       foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr") [];
504       StgTSO_trec(CurrentTSO) = outer;
505       Sp = Sp + SIZEOF_StgCatchSTMFrame;
506     }
507
508     /* Ensure that async excpetions are blocked when running the handler.
509     */
510     StgTSO_flags(CurrentTSO) = 
511         StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
512
513     /* Call the handler, passing the exception value and a realworld
514      * token as arguments.
515      */
516     Sp_adj(-1);
517     Sp(0) = exception;
518     R1 = handler;
519     Sp_adj(-1);
520     TICK_UNKNOWN_CALL();
521     TICK_SLOW_CALL_pv();
522     jump RET_LBL(stg_ap_pv);
523 }
524
525 stg_raiseIOzh
526 {
527   /* Args :: R1 :: Exception */
528   jump stg_raisezh;
529 }