Use message-passing to implement throwTo in the RTS
[ghc.git] / rts / HeapStackCheck.cmm
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team, 1998-2004
4  *
5  * Canned Heap-Check and Stack-Check sequences.
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 #ifdef __PIC__
16 import pthread_mutex_unlock;
17 #endif
18 import EnterCriticalSection;
19 import LeaveCriticalSection;
20
21 /* Stack/Heap Check Failure
22  * ------------------------
23  *
24  * On discovering that a stack or heap check has failed, we do the following:
25  *
26  *    - If HpLim==0, indicating that we should context-switch, we yield
27  *      to the scheduler (return ThreadYielding).
28  *
29  * Note that we must leave no slop in the heap (this is a requirement
30  * for LDV profiling, at least), so if we just had a heap-check
31  * failure, then we must retract Hp by HpAlloc.  How do we know
32  * whether there was a heap-check failure?  HpLim might be zero, and
33  * yet we got here as a result of a stack-check failure.  Hence, we
34  * require that HpAlloc is only non-zero if there was a heap-check
35  * failure, otherwise it is zero, so we can always safely subtract
36  * HpAlloc from Hp.
37  *
38  * Hence, HpAlloc is zeroed in LOAD_THREAD_STATE().
39  *
40  *    - If the context_switch flag is set (the backup plan if setting HpLim
41  *      to 0 didn't trigger a context switch), we yield to the scheduler
42  *      (return ThreadYielding).
43  *
44  *    - If Hp > HpLim, we've had a heap check failure.  This means we've
45  *      come to the end of the current heap block, so we try to chain
46  *      another block on with ExtendNursery().  
47  *
48  *           - If this succeeds, we carry on without returning to the 
49  *             scheduler.  
50  *
51  *           - If it fails, we return to the scheduler claiming HeapOverflow
52  *             so that a garbage collection can be performed.
53  *
54  *    - If Hp <= HpLim, it must have been a stack check that failed.  In
55  *      which case, we return to the scheduler claiming StackOverflow, the
56  *      scheduler will either increase the size of our stack, or raise
57  *      an exception if the stack is already too big.
58  *
59  * The effect of checking for context switch only in the heap/stack check
60  * failure code is that we'll switch threads after the current thread has
61  * reached the end of its heap block.  If a thread isn't allocating
62  * at all, it won't yield.  Hopefully this won't be a problem in practice.
63  */
64  
65 #define PRE_RETURN(why,what_next)                       \
66   StgTSO_what_next(CurrentTSO) = what_next::I16;        \
67   StgRegTable_rRet(BaseReg) = why;                      \
68   R1 = BaseReg;
69
70 /* Remember that the return address is *removed* when returning to a
71  * ThreadRunGHC thread.
72  */
73
74 #define GC_GENERIC                                              \
75     DEBUG_ONLY(foreign "C" heapCheckFail());                    \
76     if (Hp > HpLim) {                                           \
77         Hp = Hp - HpAlloc/*in bytes*/;                          \
78         if (HpLim == 0) { \
79                 R1 = ThreadYielding;                            \
80                 goto sched;                                     \
81         }                                               \
82         if (HpAlloc <= BLOCK_SIZE                               \
83             && bdescr_link(CurrentNursery) != NULL) {           \
84             HpAlloc = 0;                                        \
85             CLOSE_NURSERY();                                    \
86             CurrentNursery = bdescr_link(CurrentNursery);       \
87             OPEN_NURSERY();                                     \
88             if (Capability_context_switch(MyCapability()) != 0 :: CInt) { \
89                 R1 = ThreadYielding;                            \
90                 goto sched;                                     \
91             } else {                                            \
92                 jump %ENTRY_CODE(Sp(0));                        \
93             }                                                   \
94         } else {                                                \
95             R1 = HeapOverflow;                                  \
96             goto sched;                                         \
97         }                                                       \
98     } else {                                                    \
99         R1 = StackOverflow;                                     \
100     }                                                           \
101   sched:                                                        \
102     PRE_RETURN(R1,ThreadRunGHC);                                \
103     jump stg_returnToSched;
104
105 #define HP_GENERIC                              \
106    PRE_RETURN(HeapOverflow, ThreadRunGHC)       \
107   jump stg_returnToSched;
108
109 #define BLOCK_GENERIC                           \
110    PRE_RETURN(ThreadBlocked,  ThreadRunGHC)     \
111   jump stg_returnToSched;
112
113 #define YIELD_GENERIC                           \
114   PRE_RETURN(ThreadYielding, ThreadRunGHC)      \
115   jump stg_returnToSched;
116
117 #define BLOCK_BUT_FIRST(c)                      \
118   PRE_RETURN(ThreadBlocked, ThreadRunGHC)       \
119   R2 = c;                                       \
120   jump stg_returnToSchedButFirst;
121
122 #define YIELD_TO_INTERPRETER                    \
123   PRE_RETURN(ThreadYielding, ThreadInterpret)   \
124   jump stg_returnToSchedNotPaused;
125
126 /* -----------------------------------------------------------------------------
127    Heap checks in thunks/functions.
128
129    In these cases, node always points to the function closure.  This gives
130    us an easy way to return to the function: just leave R1 on the top of
131    the stack, and have the scheduler enter it to return.
132
133    There are canned sequences for 'n' pointer values in registers.
134    -------------------------------------------------------------------------- */
135
136 INFO_TABLE_RET( stg_enter, RET_SMALL, P_ unused)
137 {
138     R1 = Sp(1);
139     Sp_adj(2);
140     ENTER();
141 }
142
143 __stg_gc_enter_1
144 {
145     Sp_adj(-2);
146     Sp(1) = R1;
147     Sp(0) = stg_enter_info;
148     GC_GENERIC
149 }
150
151 /* -----------------------------------------------------------------------------
152    Heap checks in Primitive case alternatives
153
154    A primitive case alternative is entered with a value either in 
155    R1, FloatReg1 or D1 depending on the return convention.  All the
156    cases are covered below.
157    -------------------------------------------------------------------------- */
158
159 /*-- No Registers live ------------------------------------------------------ */
160
161 stg_gc_noregs
162 {
163     GC_GENERIC
164 }
165
166 /*-- void return ------------------------------------------------------------ */
167
168 INFO_TABLE_RET( stg_gc_void, RET_SMALL)
169 {
170     Sp_adj(1);
171     jump %ENTRY_CODE(Sp(0));
172 }
173
174 /*-- R1 is boxed/unpointed -------------------------------------------------- */
175
176 INFO_TABLE_RET( stg_gc_unpt_r1, RET_SMALL, P_ unused)
177 {
178     R1 = Sp(1);
179     Sp_adj(2);
180     jump %ENTRY_CODE(Sp(0));
181 }
182
183 stg_gc_unpt_r1
184 {
185     Sp_adj(-2);
186     Sp(1) = R1;
187     Sp(0) = stg_gc_unpt_r1_info;
188     GC_GENERIC
189 }
190
191 /*-- R1 is unboxed -------------------------------------------------- */
192
193 /* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
194 INFO_TABLE_RET( stg_gc_unbx_r1, RET_SMALL, W_ unused )
195 {
196     R1 = Sp(1);
197     Sp_adj(2);
198     jump %ENTRY_CODE(Sp(0));
199 }
200
201 stg_gc_unbx_r1
202 {
203     Sp_adj(-2);
204     Sp(1) = R1;
205     Sp(0) = stg_gc_unbx_r1_info;
206     GC_GENERIC
207 }
208
209 /*-- F1 contains a float ------------------------------------------------- */
210
211 INFO_TABLE_RET( stg_gc_f1, RET_SMALL, F_ unused )
212 {
213     F1 = F_[Sp+WDS(1)];
214     Sp_adj(2);
215     jump %ENTRY_CODE(Sp(0));
216 }
217
218 stg_gc_f1
219 {
220     Sp_adj(-2);
221     F_[Sp + WDS(1)] = F1;
222     Sp(0) = stg_gc_f1_info;
223     GC_GENERIC
224 }
225
226 /*-- D1 contains a double ------------------------------------------------- */
227
228 INFO_TABLE_RET( stg_gc_d1, RET_SMALL, D_ unused )
229 {
230     D1 = D_[Sp + WDS(1)];
231     Sp = Sp + WDS(1) + SIZEOF_StgDouble;
232     jump %ENTRY_CODE(Sp(0));
233 }
234
235 stg_gc_d1
236 {
237     Sp = Sp - WDS(1) - SIZEOF_StgDouble;
238     D_[Sp + WDS(1)] = D1;
239     Sp(0) = stg_gc_d1_info;
240     GC_GENERIC
241 }
242
243
244 /*-- L1 contains an int64 ------------------------------------------------- */
245
246 INFO_TABLE_RET( stg_gc_l1, RET_SMALL, L_ unused )
247 {
248     L1 = L_[Sp + WDS(1)];
249     Sp_adj(1) + SIZEOF_StgWord64;
250     jump %ENTRY_CODE(Sp(0));
251 }
252
253 stg_gc_l1
254 {
255     Sp_adj(-1) - SIZEOF_StgWord64;
256     L_[Sp + WDS(1)] = L1;
257     Sp(0) = stg_gc_l1_info;
258     GC_GENERIC
259 }
260
261 /*-- Unboxed tuple return, one pointer (unregisterised build only) ---------- */
262
263 INFO_TABLE_RET( stg_ut_1_0_unreg, RET_SMALL, P_ unused )
264 {
265     Sp_adj(1);
266     // one ptr is on the stack (Sp(0))
267     jump %ENTRY_CODE(Sp(1));
268 }
269
270 /* -----------------------------------------------------------------------------
271    Generic function entry heap check code.
272
273    At a function entry point, the arguments are as per the calling convention,
274    i.e. some in regs and some on the stack.  There may or may not be 
275    a pointer to the function closure in R1 - if there isn't, then the heap
276    check failure code in the function will arrange to load it.
277
278    The function's argument types are described in its info table, so we
279    can just jump to this bit of generic code to save away all the
280    registers and return to the scheduler.
281
282    This code arranges the stack like this:
283          
284          |        ....         |
285          |        args         |
286          +---------------------+
287          |      f_closure      |
288          +---------------------+
289          |        size         |
290          +---------------------+
291          |   stg_gc_fun_info   |
292          +---------------------+
293
294    The size is the number of words of arguments on the stack, and is cached
295    in the frame in order to simplify stack walking: otherwise the size of
296    this stack frame would have to be calculated by looking at f's info table.
297
298    -------------------------------------------------------------------------- */
299
300 __stg_gc_fun
301 {
302     W_ size;
303     W_ info;
304     W_ type;
305
306     info = %GET_FUN_INFO(UNTAG(R1));
307
308     // cache the size
309     type = TO_W_(StgFunInfoExtra_fun_type(info));
310     if (type == ARG_GEN) {
311         size = BITMAP_SIZE(StgFunInfoExtra_bitmap(info));
312     } else { 
313         if (type == ARG_GEN_BIG) {
314 #ifdef TABLES_NEXT_TO_CODE
315             // bitmap field holds an offset
316             size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info)
317                                         + %GET_ENTRY(UNTAG(R1)) /* ### */ );
318 #else
319             size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) );
320 #endif
321         } else {
322             size = BITMAP_SIZE(W_[stg_arg_bitmaps + WDS(type)]);
323         }
324     }
325     
326 #ifdef NO_ARG_REGS
327     // we don't have to save any registers away
328     Sp_adj(-3);
329     Sp(2) = R1;
330     Sp(1) = size;
331     Sp(0) = stg_gc_fun_info;
332     GC_GENERIC
333 #else
334     W_ type;
335     type = TO_W_(StgFunInfoExtra_fun_type(info));
336     // cache the size
337     if (type == ARG_GEN || type == ARG_GEN_BIG) {
338         // regs already saved by the heap check code
339         Sp_adj(-3);
340         Sp(2) = R1;
341         Sp(1) = size;
342         Sp(0) = stg_gc_fun_info;
343         // DEBUG_ONLY(foreign "C" debugBelch("stg_fun_gc_gen(ARG_GEN)"););
344         GC_GENERIC
345     } else { 
346         jump W_[stg_stack_save_entries + WDS(type)];
347             // jumps to stg_gc_noregs after saving stuff
348     }
349 #endif /* !NO_ARG_REGS */
350 }
351
352 /* -----------------------------------------------------------------------------
353    Generic Apply (return point)
354
355    The dual to stg_fun_gc_gen (above): this fragment returns to the
356    function, passing arguments in the stack and in registers
357    appropriately.  The stack layout is given above.
358    -------------------------------------------------------------------------- */
359
360 INFO_TABLE_RET( stg_gc_fun, RET_FUN )
361 {
362     R1 = Sp(2);
363     Sp_adj(3);
364 #ifdef NO_ARG_REGS
365     // Minor optimisation: there are no argument registers to load up,
366     // so we can just jump straight to the function's entry point.
367     jump %GET_ENTRY(UNTAG(R1));
368 #else
369     W_ info;
370     W_ type;
371     
372     info = %GET_FUN_INFO(UNTAG(R1));
373     type = TO_W_(StgFunInfoExtra_fun_type(info));
374     if (type == ARG_GEN || type == ARG_GEN_BIG) {
375         jump StgFunInfoExtra_slow_apply(info);
376     } else { 
377         if (type == ARG_BCO) {
378             // cover this case just to be on the safe side
379             Sp_adj(-2);
380             Sp(1) = R1;
381             Sp(0) = stg_apply_interp_info;
382             jump stg_yield_to_interpreter;
383         } else {
384             jump W_[stg_ap_stack_entries + WDS(type)];
385         }
386     }
387 #endif
388 }
389
390 /* -----------------------------------------------------------------------------
391    Generic Heap Check Code.
392
393    Called with Liveness mask in R9,  Return address in R10.
394    Stack must be consistent (containing all necessary info pointers
395    to relevant SRTs).
396
397    See StgMacros.h for a description of the RET_DYN stack frame.
398
399    We also define an stg_gen_yield here, because it's very similar.
400    -------------------------------------------------------------------------- */
401
402 // For simplicity, we assume that SIZEOF_DOUBLE == 2*SIZEOF_VOID_P
403 // on a 64-bit machine, we'll end up wasting a couple of words, but
404 // it's not a big deal.
405
406 #define RESTORE_EVERYTHING                      \
407     L1   = L_[Sp + WDS(19)];                    \
408     D2   = D_[Sp + WDS(17)];                    \
409     D1   = D_[Sp + WDS(15)];                    \
410     F4   = F_[Sp + WDS(14)];                    \
411     F3   = F_[Sp + WDS(13)];                    \
412     F2   = F_[Sp + WDS(12)];                    \
413     F1   = F_[Sp + WDS(11)];                    \
414     R8 = Sp(10);                                \
415     R7 = Sp(9);                                 \
416     R6 = Sp(8);                                 \
417     R5 = Sp(7);                                 \
418     R4 = Sp(6);                                 \
419     R3 = Sp(5);                                 \
420     R2 = Sp(4);                                 \
421     R1 = Sp(3);                                 \
422     Sp_adj(21);
423
424 #define RET_OFFSET (-19)
425
426 #define SAVE_EVERYTHING                         \
427     Sp_adj(-21);                                \
428     L_[Sp + WDS(19)] = L1;                      \
429     D_[Sp + WDS(17)] = D2;                      \
430     D_[Sp + WDS(15)] = D1;                      \
431     F_[Sp + WDS(14)] = F4;                      \
432     F_[Sp + WDS(13)] = F3;                      \
433     F_[Sp + WDS(12)] = F2;                      \
434     F_[Sp + WDS(11)] = F1;                      \
435     Sp(10) = R8;                                \
436     Sp(9) = R7;                                 \
437     Sp(8) = R6;                                 \
438     Sp(7) = R5;                                 \
439     Sp(6) = R4;                                 \
440     Sp(5) = R3;                                 \
441     Sp(4) = R2;                                 \
442     Sp(3) = R1;                                 \
443     Sp(2) = R10;    /* return address */        \
444     Sp(1) = R9;     /* liveness mask  */        \
445     Sp(0) = stg_gc_gen_info;
446
447 INFO_TABLE_RET( stg_gc_gen, RET_DYN )
448 /* bitmap in the above info table is unused, the real one is on the stack. */
449 {
450     RESTORE_EVERYTHING;
451     jump Sp(RET_OFFSET); /* No %ENTRY_CODE( - this is an actual code ptr */
452 }
453
454 stg_gc_gen
455 {
456     SAVE_EVERYTHING;
457     GC_GENERIC
458 }         
459
460 // A heap check at an unboxed tuple return point.  The return address
461 // is on the stack, and we can find it by using the offsets given
462 // to us in the liveness mask.
463 stg_gc_ut
464 {
465     R10 = %ENTRY_CODE(Sp(RET_DYN_NONPTRS(R9) + RET_DYN_PTRS(R9)));
466     SAVE_EVERYTHING;
467     GC_GENERIC
468 }
469
470 /*
471  * stg_gen_hp is used by MAYBE_GC, where we can't use GC_GENERIC
472  * because we've just failed doYouWantToGC(), not a standard heap
473  * check.  GC_GENERIC would end up returning StackOverflow.
474  */
475 stg_gc_gen_hp
476 {
477     SAVE_EVERYTHING;
478     HP_GENERIC
479 }         
480
481 /* -----------------------------------------------------------------------------
482    Yields
483    -------------------------------------------------------------------------- */
484
485 stg_gen_yield
486 {
487     SAVE_EVERYTHING;
488     YIELD_GENERIC
489 }
490
491 stg_yield_noregs
492 {
493     YIELD_GENERIC;
494 }
495
496 /* -----------------------------------------------------------------------------
497    Yielding to the interpreter... top of stack says what to do next.
498    -------------------------------------------------------------------------- */
499
500 stg_yield_to_interpreter
501 {
502     YIELD_TO_INTERPRETER;
503 }
504
505 /* -----------------------------------------------------------------------------
506    Blocks
507    -------------------------------------------------------------------------- */
508
509 stg_gen_block
510 {
511     SAVE_EVERYTHING;
512     BLOCK_GENERIC;
513 }
514
515 stg_block_noregs
516 {
517     BLOCK_GENERIC;
518 }
519
520 stg_block_1
521 {
522     Sp_adj(-2);
523     Sp(1) = R1;
524     Sp(0) = stg_enter_info;
525     BLOCK_GENERIC;
526 }
527
528 /* -----------------------------------------------------------------------------
529  * takeMVar/putMVar-specific blocks
530  *
531  * Stack layout for a thread blocked in takeMVar:
532  *      
533  *       ret. addr
534  *       ptr to MVar   (R1)
535  *       stg_block_takemvar_info
536  *
537  * Stack layout for a thread blocked in putMVar:
538  *      
539  *       ret. addr
540  *       ptr to Value  (R2)
541  *       ptr to MVar   (R1)
542  *       stg_block_putmvar_info
543  *
544  * See PrimOps.hc for a description of the workings of take/putMVar.
545  * 
546  * -------------------------------------------------------------------------- */
547
548 INFO_TABLE_RET( stg_block_takemvar, RET_SMALL, P_ unused )
549 {
550     R1 = Sp(1);
551     Sp_adj(2);
552     jump stg_takeMVarzh;
553 }
554
555 // code fragment executed just before we return to the scheduler
556 stg_block_takemvar_finally
557 {
558 #ifdef THREADED_RTS
559     unlockClosure(R3, stg_MVAR_DIRTY_info);
560 #else
561     SET_INFO(R3, stg_MVAR_DIRTY_info);
562 #endif
563     jump StgReturn;
564 }
565
566 stg_block_takemvar
567 {
568     Sp_adj(-2);
569     Sp(1) = R1;
570     Sp(0) = stg_block_takemvar_info;
571     R3 = R1;
572     BLOCK_BUT_FIRST(stg_block_takemvar_finally);
573 }
574
575 INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, P_ unused1, P_ unused2 )
576 {
577     R2 = Sp(2);
578     R1 = Sp(1);
579     Sp_adj(3);
580     jump stg_putMVarzh;
581 }
582
583 // code fragment executed just before we return to the scheduler
584 stg_block_putmvar_finally
585 {
586 #ifdef THREADED_RTS
587     unlockClosure(R3, stg_MVAR_DIRTY_info);
588 #else
589     SET_INFO(R3, stg_MVAR_DIRTY_info);
590 #endif
591     jump StgReturn;
592 }
593
594 stg_block_putmvar
595 {
596     Sp_adj(-3);
597     Sp(2) = R2;
598     Sp(1) = R1;
599     Sp(0) = stg_block_putmvar_info;
600     R3 = R1;
601     BLOCK_BUT_FIRST(stg_block_putmvar_finally);
602 }
603
604 // code fragment executed just before we return to the scheduler
605 stg_block_blackhole_finally
606 {
607 #if defined(THREADED_RTS)
608     // The last thing we do is release sched_lock, which is
609     // preventing other threads from accessing blackhole_queue and
610     // picking up this thread before we are finished with it.
611     RELEASE_LOCK(sched_mutex "ptr");
612 #endif
613     jump StgReturn;
614 }
615
616 stg_block_blackhole
617 {
618     Sp_adj(-2);
619     Sp(1) = R1;
620     Sp(0) = stg_enter_info;
621     BLOCK_BUT_FIRST(stg_block_blackhole_finally);
622 }
623
624 INFO_TABLE_RET( stg_block_throwto, RET_SMALL, P_ unused, P_ unused )
625 {
626     R2 = Sp(2);
627     R1 = Sp(1);
628     Sp_adj(3);
629     jump stg_killThreadzh;
630 }
631
632 stg_block_throwto_finally
633 {
634     // unlock the throwto message
635     unlockClosure(StgTSO_block_info(CurrentTSO), stg_MSG_THROWTO_info);
636     jump StgReturn;
637 }
638
639 stg_block_throwto
640 {
641     Sp_adj(-3);
642     Sp(2) = R2;
643     Sp(1) = R1;
644     Sp(0) = stg_block_throwto_info;
645     BLOCK_BUT_FIRST(stg_block_throwto_finally);
646 }
647
648 #ifdef mingw32_HOST_OS
649 INFO_TABLE_RET( stg_block_async, RET_SMALL )
650 {
651     W_ ares;
652     W_ len, errC;
653
654     ares = StgTSO_block_info(CurrentTSO);
655     len = StgAsyncIOResult_len(ares);
656     errC = StgAsyncIOResult_errCode(ares);
657     StgTSO_block_info(CurrentTSO) = NULL;
658     foreign "C" free(ares "ptr");
659     R1 = len;
660     Sp(0) = errC;
661     jump %ENTRY_CODE(Sp(1));
662 }
663
664 stg_block_async
665 {
666     Sp_adj(-1);
667     Sp(0) = stg_block_async_info;
668     BLOCK_GENERIC;
669 }
670
671 /* Used by threadDelay implementation; it would be desirable to get rid of
672  * this free()'ing void return continuation.
673  */
674 INFO_TABLE_RET( stg_block_async_void, RET_SMALL )
675 {
676     W_ ares;
677
678     ares = StgTSO_block_info(CurrentTSO);
679     StgTSO_block_info(CurrentTSO) = NULL;
680     foreign "C" free(ares "ptr");
681     Sp_adj(1);
682     jump %ENTRY_CODE(Sp(0));
683 }
684
685 stg_block_async_void
686 {
687     Sp_adj(-1);
688     Sp(0) = stg_block_async_void_info;
689     BLOCK_GENERIC;
690 }
691
692 #endif
693
694 /* -----------------------------------------------------------------------------
695    STM-specific waiting
696    -------------------------------------------------------------------------- */
697
698 stg_block_stmwait_finally
699 {
700     foreign "C" stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
701     jump StgReturn;
702 }
703
704 stg_block_stmwait
705 {
706     BLOCK_BUT_FIRST(stg_block_stmwait_finally);
707 }