profiling fixes
[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_GHCziTypes_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         maskAsyncExceptions# :: 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         unmaskAsyncExceptions# :: 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 maskAsyncExceptions# (there is an
43    unmaskAsyncExceptions_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 unmaskAsyncExceptions_ret frame.  Later, when
47    someone else evaluates this thunk, the blocked exception state is
48    not restored.
49
50    -------------------------------------------------------------------------- */
51
52
53 INFO_TABLE_RET(stg_unmaskAsyncExceptionszh_ret, RET_SMALL, W_ info_ptr)
54     /* explicit stack */
55 {
56     CInt r;
57
58     StgTSO_flags(CurrentTSO) = %lobits32(
59       TO_W_(StgTSO_flags(CurrentTSO)) & ~(TSO_BLOCKEX|TSO_INTERRUPTIBLE));
60
61     /* Eagerly raise a blocked exception, if there is one */
62     if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
63
64         STK_CHK_P (WDS(2), stg_unmaskAsyncExceptionszh_ret_info, R1);
65         /* 
66          * We have to be very careful here, as in killThread#, since
67          * we are about to raise an async exception in the current
68          * thread, which might result in the thread being killed.
69          */
70         Sp_adj(-2);
71         Sp(1) = R1;
72         Sp(0) = stg_ret_p_info;
73         SAVE_THREAD_STATE();
74         (r) = ccall maybePerformBlockedException (MyCapability() "ptr", 
75                                                       CurrentTSO "ptr");
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)) [R1];
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)) [R1];
98 }
99
100 INFO_TABLE_RET(stg_maskAsyncExceptionszh_ret, RET_SMALL, W_ info_ptr)
101     return (P_ ret)
102 {
103     StgTSO_flags(CurrentTSO) = 
104        %lobits32(
105          TO_W_(StgTSO_flags(CurrentTSO))
106           | TSO_BLOCKEX | TSO_INTERRUPTIBLE
107       );
108
109     return (ret);
110 }
111
112 INFO_TABLE_RET(stg_maskUninterruptiblezh_ret, RET_SMALL, W_ info_ptr)
113     return (P_ ret)
114 {
115     StgTSO_flags(CurrentTSO) = 
116        %lobits32(
117         (TO_W_(StgTSO_flags(CurrentTSO))
118           | TSO_BLOCKEX)
119           & ~TSO_INTERRUPTIBLE
120        );
121
122     return (ret);
123 }
124
125 stg_maskAsyncExceptionszh /* explicit stack */
126 {
127     /* Args: R1 :: IO a */
128     STK_CHK_P( WDS(1)/* worst case */, stg_maskAsyncExceptionszh, R1);
129
130     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
131         /* avoid growing the stack unnecessarily */
132         if (Sp(0) == stg_maskAsyncExceptionszh_ret_info) {
133             Sp_adj(1);
134         } else {
135             Sp_adj(-1);
136             Sp(0) = stg_unmaskAsyncExceptionszh_ret_info;
137         }
138     } else {
139         if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_INTERRUPTIBLE) == 0) {
140             Sp_adj(-1);
141             Sp(0) = stg_maskUninterruptiblezh_ret_info;
142         }
143     }
144
145     StgTSO_flags(CurrentTSO) = %lobits32(
146         TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX | TSO_INTERRUPTIBLE);
147
148     TICK_UNKNOWN_CALL();
149     TICK_SLOW_CALL_v();
150     jump stg_ap_v_fast [R1];
151 }
152
153 stg_maskUninterruptiblezh /* explicit stack */
154 {
155     /* Args: R1 :: IO a */
156     STK_CHK_P( WDS(1)/* worst case */, stg_maskAsyncExceptionszh, R1);
157
158     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
159         /* avoid growing the stack unnecessarily */
160         if (Sp(0) == stg_maskUninterruptiblezh_ret_info) {
161             Sp_adj(1);
162         } else {
163             Sp_adj(-1);
164             Sp(0) = stg_unmaskAsyncExceptionszh_ret_info;
165         }
166     } else {
167         if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_INTERRUPTIBLE) != 0) {
168             Sp_adj(-1);
169             Sp(0) = stg_maskAsyncExceptionszh_ret_info;
170         }
171     }
172
173     StgTSO_flags(CurrentTSO) = %lobits32(
174         (TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX) & ~TSO_INTERRUPTIBLE);
175
176     TICK_UNKNOWN_CALL();
177     TICK_SLOW_CALL_v();
178     jump stg_ap_v_fast [R1];
179 }
180
181 stg_unmaskAsyncExceptionszh /* explicit stack */
182 {
183     CInt r;
184     W_ level;
185
186     /* Args: R1 :: IO a */
187     STK_CHK_P (WDS(4), stg_unmaskAsyncExceptionszh, R1);
188     /* 4 words: one for the unblock frame, 3 for setting up the
189      * stack to call maybePerformBlockedException() below.
190      */
191
192     /* If exceptions are already unblocked, there's nothing to do */
193     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) {
194
195         /* avoid growing the stack unnecessarily */
196         if (Sp(0) == stg_unmaskAsyncExceptionszh_ret_info) {
197             Sp_adj(1);
198         } else {
199             Sp_adj(-1);
200             if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_INTERRUPTIBLE) != 0) {
201                 Sp(0) = stg_maskAsyncExceptionszh_ret_info;
202             } else {
203                 Sp(0) = stg_maskUninterruptiblezh_ret_info;
204             }
205         }
206
207         StgTSO_flags(CurrentTSO) = %lobits32(
208             TO_W_(StgTSO_flags(CurrentTSO)) & ~(TSO_BLOCKEX|TSO_INTERRUPTIBLE));
209
210         /* Eagerly raise a blocked exception, if there is one */
211         if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
212             /* 
213              * We have to be very careful here, as in killThread#, since
214              * we are about to raise an async exception in the current
215              * thread, which might result in the thread being killed.
216              *
217              * Now, if we are to raise an exception in the current
218              * thread, there might be an update frame above us on the
219              * stack due to unsafePerformIO.  Hence, the stack must
220              * make sense, because it is about to be snapshotted into
221              * an AP_STACK.
222              */
223             Sp_adj(-3);
224             Sp(2) = stg_ap_v_info;
225             Sp(1) = R1;
226             Sp(0) = stg_enter_info;
227
228             SAVE_THREAD_STATE();
229             (r) = ccall maybePerformBlockedException (MyCapability() "ptr", 
230                                                       CurrentTSO "ptr");
231
232             if (r != 0::CInt) {
233                 if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
234                     jump stg_threadFinished [];
235                 } else {
236                     LOAD_THREAD_STATE();
237                     ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
238                     jump %ENTRY_CODE(Sp(0)) [R1];
239                 }
240             } else {
241                 /* we'll just call R1 directly, below */
242                 Sp_adj(3);
243             }
244         }
245
246     }
247     TICK_UNKNOWN_CALL();
248     TICK_SLOW_CALL_v();
249     jump stg_ap_v_fast [R1];
250 }
251
252
253 stg_getMaskingStatezh ()
254 {
255     /* args: none */
256     /* 
257        returns: 0 == unmasked,
258                 1 == masked, non-interruptible,
259                 2 == masked, interruptible
260     */
261     return (((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) +
262             ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_INTERRUPTIBLE) != 0));
263 }
264
265 stg_killThreadzh (P_ target, P_ exception)
266 {
267     W_ why_blocked;
268
269     /* Needs 3 words because throwToSingleThreaded uses some stack */
270     STK_CHK_PP (WDS(3), stg_killThreadzh, target, exception);
271     /* We call allocate in throwTo(), so better check for GC */
272     MAYBE_GC_PP (stg_killThreadzh, target, exception);
273
274     /* 
275      * We might have killed ourselves.  In which case, better be *very*
276      * careful.  If the exception killed us, then return to the scheduler.
277      * If the exception went to a catch frame, we'll just continue from
278      * the handler.
279      */
280     if (target == CurrentTSO) {
281         /*
282          * So what should happen if a thread calls "throwTo self" inside
283          * unsafePerformIO, and later the closure is evaluated by another
284          * thread?  Presumably it should behave as if throwTo just returned,
285          * and then continue from there.  See #3279, #3288.  This is what
286          * happens: on resumption, we will just jump to the next frame on
287          * the stack, which is the return point for stg_killThreadzh.
288          */
289         R1 = target;
290         R2 = exception;
291         jump stg_killMyself [R1,R2];
292     } else {
293         W_ msg;
294
295         (msg) = ccall throwTo(MyCapability() "ptr",
296                                     CurrentTSO "ptr",
297                                     target "ptr",
298                                     exception "ptr");
299         
300         if (msg == NULL) {
301             return ();
302         } else {
303             StgTSO_why_blocked(CurrentTSO) = BlockedOnMsgThrowTo;
304             StgTSO_block_info(CurrentTSO) = msg;
305             // we must block, and unlock the message before returning
306             jump stg_block_throwto (target, exception);
307         }
308     }
309 }
310
311 /*
312  * We must switch into low-level Cmm in order to raise an exception in
313  * the current thread, hence this is in a separate proc with arguments
314  * passed explicitly in R1 and R2.
315  */
316 stg_killMyself
317 {
318     P_ target, exception;
319     target = R1;
320     exception = R2;
321
322     SAVE_THREAD_STATE();
323     /* ToDo: what if the current thread is blocking exceptions? */
324     ccall throwToSingleThreaded(MyCapability() "ptr", 
325                                 target "ptr", exception "ptr");
326     if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
327         jump stg_threadFinished [];
328     } else {
329         LOAD_THREAD_STATE();
330         ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
331         jump %ENTRY_CODE(Sp(0)) [];
332     }
333 }
334
335 /* -----------------------------------------------------------------------------
336    Catch frames
337    -------------------------------------------------------------------------- */
338
339 /* Catch frames are very similar to update frames, but when entering
340  * one we just pop the frame off the stack and perform the correct
341  * kind of return to the activation record underneath us on the stack.
342  */
343
344 #define CATCH_FRAME_FIELDS(w_,p_,info_ptr,p1,p2,exceptions_blocked,handler)   \
345   w_ info_ptr,                                                          \
346   PROF_HDR_FIELDS(w_,p1,p2)                                             \
347   w_ exceptions_blocked,                                                \
348   p_ handler
349
350
351 INFO_TABLE_RET(stg_catch_frame, CATCH_FRAME,
352                CATCH_FRAME_FIELDS(W_,P_,info_ptr, p1, p2,
353                                   exceptions_blocked,handler))
354     return (P_ ret)
355 {
356     return (ret);
357 }
358
359 /* -----------------------------------------------------------------------------
360  * The catch infotable
361  *
362  * This should be exactly the same as would be generated by this STG code
363  *
364  * catch = {x,h} \n {} -> catch#{x,h}
365  *
366  * It is used in deleteThread when reverting blackholes.
367  * -------------------------------------------------------------------------- */
368
369 INFO_TABLE(stg_catch,2,0,FUN,"catch","catch")
370     (P_ node)
371 {
372     jump stg_catchzh(StgClosure_payload(node,0),StgClosure_payload(node,1));
373 }
374
375 stg_catchzh ( P_ io,      /* :: IO a */
376               P_ handler  /* :: Exception -> IO a */ )
377 {
378     W_ exceptions_blocked;
379
380     STK_CHK_GEN();
381   
382     exceptions_blocked =
383         TO_W_(StgTSO_flags(CurrentTSO)) & (TSO_BLOCKEX | TSO_INTERRUPTIBLE);
384     TICK_CATCHF_PUSHED();
385
386     /* Apply R1 to the realworld token */
387     TICK_UNKNOWN_CALL();
388     TICK_SLOW_CALL_v();
389
390     jump stg_ap_v_fast
391         (CATCH_FRAME_FIELDS(,,stg_catch_frame_info, CCCS, 0,
392                             exceptions_blocked, handler))
393         (io);
394 }
395
396 /* -----------------------------------------------------------------------------
397  * The raise infotable
398  * 
399  * This should be exactly the same as would be generated by this STG code
400  *
401  *   raise = {err} \n {} -> raise#{err}
402  *
403  * It is used in stg_raisezh to update thunks on the update list
404  * -------------------------------------------------------------------------- */
405
406 INFO_TABLE(stg_raise,1,0,THUNK_1_0,"raise","raise")
407 {
408     jump stg_raisezh(StgThunk_payload(R1,0));
409 }
410
411 section "data" {
412   no_break_on_exception: W_[1];
413 }
414
415 INFO_TABLE_RET(stg_raise_ret, RET_SMALL, W_ info_ptr, P_ exception)
416     return (P_ ret)
417 {
418     W_[no_break_on_exception] = 1;
419     jump stg_raisezh (exception);
420 }
421
422 stg_raisezh /* explicit stack */
423 /*
424  * args : R1 :: Exception
425  *
426  * Here we assume that the NativeNodeCall convention always puts the
427  * first argument in R1 (which it does).  We cannot use high-level cmm
428  * due to all the LOAD_THREAD_STATE()/SAVE_THREAD_STATE() and stack
429  * walking that happens in here.
430  */
431 {
432     W_ handler;
433     W_ frame_type;
434     W_ exception;
435
436    exception = R1;
437
438 #if defined(PROFILING)
439     /* Debugging tool: on raising an  exception, show where we are. */
440
441     /* ToDo: currently this is a hack.  Would be much better if
442      * the info was only displayed for an *uncaught* exception.
443      */
444     if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags) != 0::I32) {
445         SAVE_THREAD_STATE();
446         ccall fprintCCS_stderr(CCCS "ptr",
447                                      exception "ptr",
448                                      CurrentTSO "ptr");
449         LOAD_THREAD_STATE();
450     }
451 #endif
452     
453 retry_pop_stack:
454     SAVE_THREAD_STATE();
455     (frame_type) = ccall raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", exception "ptr");
456     LOAD_THREAD_STATE();
457     if (frame_type == ATOMICALLY_FRAME) {
458       /* The exception has reached the edge of a memory transaction.  Check that 
459        * the transaction is valid.  If not then perhaps the exception should
460        * not have been thrown: re-run the transaction.  "trec" will either be
461        * a top-level transaction running the atomic block, or a nested 
462        * transaction running an invariant check.  In the latter case we
463        * abort and de-allocate the top-level transaction that encloses it
464        * as well (we could just abandon its transaction record, but this makes
465        * sure it's marked as aborted and available for re-use). */
466       W_ trec, outer;
467       W_ r;
468       trec = StgTSO_trec(CurrentTSO);
469       (r) = ccall stmValidateNestOfTransactions(trec "ptr");
470       outer  = StgTRecHeader_enclosing_trec(trec);
471       ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
472       ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
473
474       if (outer != NO_TREC) {
475         ccall stmAbortTransaction(MyCapability() "ptr", outer "ptr");
476         ccall stmFreeAbortedTRec(MyCapability() "ptr", outer "ptr");
477       }
478
479       StgTSO_trec(CurrentTSO) = NO_TREC;
480       if (r != 0) {
481         // Transaction was valid: continue searching for a catch frame
482         Sp = Sp + SIZEOF_StgAtomicallyFrame;
483         goto retry_pop_stack;
484       } else {
485         // Transaction was not valid: we retry the exception (otherwise continue
486         // with a further call to raiseExceptionHelper)
487         ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr");
488         StgTSO_trec(CurrentTSO) = trec;
489         R1 = StgAtomicallyFrame_code(Sp);
490         jump stg_ap_v_fast [R1];
491       }          
492     }
493
494     // After stripping the stack, see whether we should break here for
495     // GHCi (c.f. the -fbreak-on-exception flag).  We do this after
496     // stripping the stack for a reason: we'll be inspecting values in
497     // GHCi, and it helps if all the thunks under evaluation have
498     // already been updated with the exception, rather than being left
499     // as blackholes.
500     if (W_[no_break_on_exception] != 0) {
501         W_[no_break_on_exception] = 0;
502     } else {
503         if (TO_W_(CInt[rts_stop_on_exception]) != 0) {
504             W_ ioAction;
505             // we don't want any further exceptions to be caught,
506             // until GHCi is ready to handle them.  This prevents
507             // deadlock if an exception is raised in InteractiveUI,
508             // for exmplae.  Perhaps the stop_on_exception flag should
509             // be per-thread.
510             CInt[rts_stop_on_exception] = 0;
511             ("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
512             Sp = Sp - WDS(6);
513             Sp(5) = exception;
514             Sp(4) = stg_raise_ret_info;
515             Sp(3) = exception;             // the AP_STACK
516             Sp(2) = ghczmprim_GHCziTypes_True_closure; // dummy breakpoint info
517             Sp(1) = ghczmprim_GHCziTypes_True_closure; // True <=> a breakpoint
518             R1 = ioAction;
519             jump RET_LBL(stg_ap_pppv) [R1];
520         }
521     }
522
523     if (frame_type == STOP_FRAME) {
524         /*
525          * We've stripped the entire stack, the thread is now dead.
526          * We will leave the stack in a GC'able state, see the stg_stop_thread
527          * entry code in StgStartup.cmm.
528          */
529         W_ stack;
530         stack = StgTSO_stackobj(CurrentTSO);
531         Sp = stack + OFFSET_StgStack_stack
532                 + WDS(TO_W_(StgStack_stack_size(stack))) - WDS(2);
533         Sp(1) = exception;      /* save the exception */
534         Sp(0) = stg_enter_info; /* so that GC can traverse this stack */
535         StgTSO_what_next(CurrentTSO) = ThreadKilled::I16;
536         SAVE_THREAD_STATE();    /* inline! */
537
538         jump stg_threadFinished [];
539     }
540
541     /* Ok, Sp points to the enclosing CATCH_FRAME or CATCH_STM_FRAME.
542      * Pop everything down to and including this frame, update Su,
543      * push R1, and enter the handler.
544      */
545     if (frame_type == CATCH_FRAME) {
546       handler = StgCatchFrame_handler(Sp);
547     } else {
548       handler = StgCatchSTMFrame_handler(Sp);
549     }
550
551     /* Restore the blocked/unblocked state for asynchronous exceptions
552      * at the CATCH_FRAME.  
553      *
554      * If exceptions were unblocked, arrange that they are unblocked
555      * again after executing the handler by pushing an
556      * unmaskAsyncExceptions_ret stack frame.
557      *
558      * If we've reached an STM catch frame then roll back the nested
559      * transaction we were using.
560      */
561     W_ frame;
562     frame = Sp;
563     if (frame_type == CATCH_FRAME)
564     {
565       Sp = Sp + SIZEOF_StgCatchFrame;
566       if ((StgCatchFrame_exceptions_blocked(frame) & TSO_BLOCKEX) == 0) {
567           Sp_adj(-1);
568           Sp(0) = stg_unmaskAsyncExceptionszh_ret_info;
569       }
570
571       /* Ensure that async excpetions are blocked when running the handler.
572       */
573       StgTSO_flags(CurrentTSO) = %lobits32(
574           TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX | TSO_INTERRUPTIBLE);
575
576       /* The interruptible state is inherited from the context of the
577        * catch frame, but note that TSO_INTERRUPTIBLE is only meaningful
578        * if TSO_BLOCKEX is set.  (we got this wrong earlier, and #4988
579        * was a symptom of the bug).
580        */
581       if ((StgCatchFrame_exceptions_blocked(frame) &
582            (TSO_BLOCKEX | TSO_INTERRUPTIBLE)) == TSO_BLOCKEX) {
583           StgTSO_flags(CurrentTSO) = %lobits32(
584               TO_W_(StgTSO_flags(CurrentTSO)) & ~TSO_INTERRUPTIBLE);
585       }
586     }
587     else /* CATCH_STM_FRAME */
588     {
589       W_ trec, outer;
590       trec = StgTSO_trec(CurrentTSO);
591       outer  = StgTRecHeader_enclosing_trec(trec);
592       ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
593       ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
594       StgTSO_trec(CurrentTSO) = outer;
595       Sp = Sp + SIZEOF_StgCatchSTMFrame;
596     }
597
598     /* Call the handler, passing the exception value and a realworld
599      * token as arguments.
600      */
601     Sp_adj(-1);
602     Sp(0) = exception;
603     R1 = handler;
604     Sp_adj(-1);
605     TICK_UNKNOWN_CALL();
606     TICK_SLOW_CALL_pv();
607     jump RET_LBL(stg_ap_pv) [R1];
608 }
609
610 stg_raiseIOzh (P_ exception)
611 {
612     jump stg_raisezh (exception);
613 }