FIX compacting GC (bug1010, and other failures)
[ghc-hetmet.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 /* Stack/Heap Check Failure
16  * ------------------------
17  *
18  * On discovering that a stack or heap check has failed, we do the following:
19  *
20  *    - If the context_switch flag is set, indicating that there are more
21  *      threads waiting to run, we yield to the scheduler 
22  *      (return ThreadYielding).
23  *
24  *    - If Hp > HpLim, we've had a heap check failure.  This means we've
25  *      come to the end of the current heap block, so we try to chain
26  *      another block on with ExtendNursery().  
27  *
28  *           - If this succeeds, we carry on without returning to the 
29  *             scheduler.  
30  *
31  *           - If it fails, we return to the scheduler claiming HeapOverflow
32  *             so that a garbage collection can be performed.
33  *
34  *    - If Hp <= HpLim, it must have been a stack check that failed.  In
35  *      which case, we return to the scheduler claiming StackOverflow, the
36  *      scheduler will either increase the size of our stack, or raise
37  *      an exception if the stack is already too big.
38  *
39  * The effect of checking for context switch only in the heap/stack check
40  * failure code is that we'll switch threads after the current thread has
41  * reached the end of its heap block.  If a thread isn't allocating
42  * at all, it won't yield.  Hopefully this won't be a problem in practice.
43  */
44  
45 #define PRE_RETURN(why,what_next)                       \
46   StgTSO_what_next(CurrentTSO) = what_next::I16;        \
47   StgRegTable_rRet(BaseReg) = why;                      \
48   R1 = BaseReg;
49
50 /* Remember that the return address is *removed* when returning to a
51  * ThreadRunGHC thread.
52  */
53
54 #define GC_GENERIC                                              \
55     DEBUG_ONLY(foreign "C" heapCheckFail());                    \
56     if (Hp > HpLim) {                                           \
57         Hp = Hp - HpAlloc/*in bytes*/;                          \
58         if (HpAlloc <= BLOCK_SIZE                               \
59             && bdescr_link(CurrentNursery) != NULL) {           \
60             CLOSE_NURSERY();                                    \
61             CurrentNursery = bdescr_link(CurrentNursery);       \
62             OPEN_NURSERY();                                     \
63             if (CInt[context_switch] != 0 :: CInt) {            \
64                 R1 = ThreadYielding;                            \
65                 goto sched;                                     \
66             } else {                                            \
67                 jump %ENTRY_CODE(Sp(0));                        \
68             }                                                   \
69         } else {                                                \
70             R1 = HeapOverflow;                                  \
71             goto sched;                                         \
72         }                                                       \
73     } else {                                                    \
74         R1 = StackOverflow;                                     \
75     }                                                           \
76   sched:                                                        \
77     PRE_RETURN(R1,ThreadRunGHC);                                \
78     jump stg_returnToSched;
79
80 #define HP_GENERIC                              \
81    PRE_RETURN(HeapOverflow, ThreadRunGHC)       \
82   jump stg_returnToSched;
83
84 #define BLOCK_GENERIC                           \
85    PRE_RETURN(ThreadBlocked,  ThreadRunGHC)     \
86   jump stg_returnToSched;
87
88 #define YIELD_GENERIC                           \
89   PRE_RETURN(ThreadYielding, ThreadRunGHC)      \
90   jump stg_returnToSched;
91
92 #define BLOCK_BUT_FIRST(c)                      \
93   PRE_RETURN(ThreadBlocked, ThreadRunGHC)       \
94   R2 = c;                                       \
95   jump stg_returnToSchedButFirst;
96
97 #define YIELD_TO_INTERPRETER                    \
98   PRE_RETURN(ThreadYielding, ThreadInterpret)   \
99   jump stg_returnToSchedNotPaused;
100
101 /* -----------------------------------------------------------------------------
102    Heap checks in thunks/functions.
103
104    In these cases, node always points to the function closure.  This gives
105    us an easy way to return to the function: just leave R1 on the top of
106    the stack, and have the scheduler enter it to return.
107
108    There are canned sequences for 'n' pointer values in registers.
109    -------------------------------------------------------------------------- */
110
111 INFO_TABLE_RET( stg_enter, RET_SMALL, "ptr" W_ unused)
112 {
113     R1 = Sp(1);
114     Sp_adj(2);
115     ENTER();
116 }
117
118 __stg_gc_enter_1
119 {
120     Sp_adj(-2);
121     Sp(1) = R1;
122     Sp(0) = stg_enter_info;
123     GC_GENERIC
124 }
125
126 #if defined(GRAN)
127 /*
128   ToDo: merge the block and yield macros, calling something like BLOCK(N)
129         at the end;
130 */
131
132 /* 
133    Should we actually ever do a yield in such a case?? -- HWL
134 */
135 gran_yield_0
136 {
137     SAVE_THREAD_STATE();                                        
138     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
139     R1 = ThreadYielding;
140     jump StgReturn;
141 }
142
143 gran_yield_1
144 {
145     Sp_adj(-1);
146     Sp(0) = R1;
147     SAVE_THREAD_STATE();                                        
148     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
149     R1 = ThreadYielding;
150     jump StgReturn;
151 }
152
153 /*- 2 Regs--------------------------------------------------------------------*/
154
155 gran_yield_2
156 {
157     Sp_adj(-2);
158     Sp(1) = R2;
159     Sp(0) = R1;
160     SAVE_THREAD_STATE();                                        
161     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
162     R1 = ThreadYielding;
163     jump StgReturn;
164 }
165
166 /*- 3 Regs -------------------------------------------------------------------*/
167
168 gran_yield_3
169 {
170     Sp_adj(-3);
171     Sp(2) = R3;
172     Sp(1) = R2;
173     Sp(0) = R1;
174     SAVE_THREAD_STATE();                                        
175     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
176     R1 = ThreadYielding;
177     jump StgReturn;
178 }
179
180 /*- 4 Regs -------------------------------------------------------------------*/
181
182 gran_yield_4
183 {
184     Sp_adj(-4);
185     Sp(3) = R4;
186     Sp(2) = R3;
187     Sp(1) = R2;
188     Sp(0) = R1;
189     SAVE_THREAD_STATE();                                        
190     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
191     R1 = ThreadYielding;
192     jump StgReturn;
193 }
194
195 /*- 5 Regs -------------------------------------------------------------------*/
196
197 gran_yield_5
198 {
199     Sp_adj(-5);
200     Sp(4) = R5;
201     Sp(3) = R4;
202     Sp(2) = R3;
203     Sp(1) = R2;
204     Sp(0) = R1;
205     SAVE_THREAD_STATE();                                        
206     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
207     R1 = ThreadYielding;
208     jump StgReturn;
209 }
210
211 /*- 6 Regs -------------------------------------------------------------------*/
212
213 gran_yield_6
214 {
215     Sp_adj(-6);
216     Sp(5) = R6;
217     Sp(4) = R5;
218     Sp(3) = R4;
219     Sp(2) = R3;
220     Sp(1) = R2;
221     Sp(0) = R1;
222     SAVE_THREAD_STATE();                                        
223     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
224     R1 = ThreadYielding;
225     jump StgReturn;
226 }
227
228 /*- 7 Regs -------------------------------------------------------------------*/
229
230 gran_yield_7
231 {
232     Sp_adj(-7);
233     Sp(6) = R7;
234     Sp(5) = R6;
235     Sp(4) = R5;
236     Sp(3) = R4;
237     Sp(2) = R3;
238     Sp(1) = R2;
239     Sp(0) = R1;
240     SAVE_THREAD_STATE();                                        
241     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
242     R1 = ThreadYielding;
243     jump StgReturn;
244 }
245
246 /*- 8 Regs -------------------------------------------------------------------*/
247
248 gran_yield_8
249 {
250     Sp_adj(-8);
251     Sp(7) = R8;
252     Sp(6) = R7;
253     Sp(5) = R6;
254     Sp(4) = R5;
255     Sp(3) = R4;
256     Sp(2) = R3;
257     Sp(1) = R2;
258     Sp(0) = R1;
259     SAVE_THREAD_STATE();                                        
260     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
261     R1 = ThreadYielding;
262     jump StgReturn;
263 }
264
265 // the same routines but with a block rather than a yield
266
267 gran_block_1
268 {
269     Sp_adj(-1);
270     Sp(0) = R1;
271     SAVE_THREAD_STATE();                                        
272     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
273     R1 = ThreadBlocked;
274     jump StgReturn;
275 }
276
277 /*- 2 Regs--------------------------------------------------------------------*/
278
279 gran_block_2
280 {
281     Sp_adj(-2);
282     Sp(1) = R2;
283     Sp(0) = R1;
284     SAVE_THREAD_STATE();                                        
285     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
286     R1 = ThreadBlocked;
287     jump StgReturn;
288 }
289
290 /*- 3 Regs -------------------------------------------------------------------*/
291
292 gran_block_3
293 {
294     Sp_adj(-3);
295     Sp(2) = R3;
296     Sp(1) = R2;
297     Sp(0) = R1;
298     SAVE_THREAD_STATE();                                        
299     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
300     R1 = ThreadBlocked;
301     jump StgReturn;
302 }
303
304 /*- 4 Regs -------------------------------------------------------------------*/
305
306 gran_block_4
307 {
308     Sp_adj(-4);
309     Sp(3) = R4;
310     Sp(2) = R3;
311     Sp(1) = R2;
312     Sp(0) = R1;
313     SAVE_THREAD_STATE();                                        
314     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
315     R1 = ThreadBlocked;
316     jump StgReturn;
317 }
318
319 /*- 5 Regs -------------------------------------------------------------------*/
320
321 gran_block_5
322 {
323     Sp_adj(-5);
324     Sp(4) = R5;
325     Sp(3) = R4;
326     Sp(2) = R3;
327     Sp(1) = R2;
328     Sp(0) = R1;
329     SAVE_THREAD_STATE();                                        
330     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
331     R1 = ThreadBlocked;
332     jump StgReturn;
333 }
334
335 /*- 6 Regs -------------------------------------------------------------------*/
336
337 gran_block_6
338 {
339     Sp_adj(-6);
340     Sp(5) = R6;
341     Sp(4) = R5;
342     Sp(3) = R4;
343     Sp(2) = R3;
344     Sp(1) = R2;
345     Sp(0) = R1;
346     SAVE_THREAD_STATE();                                        
347     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
348     R1 = ThreadBlocked;
349     jump StgReturn;
350 }
351
352 /*- 7 Regs -------------------------------------------------------------------*/
353
354 gran_block_7
355 {
356     Sp_adj(-7);
357     Sp(6) = R7;
358     Sp(5) = R6;
359     Sp(4) = R5;
360     Sp(3) = R4;
361     Sp(2) = R3;
362     Sp(1) = R2;
363     Sp(0) = R1;
364     SAVE_THREAD_STATE();                                        
365     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
366     R1 = ThreadBlocked;
367     jump StgReturn;
368 }
369
370 /*- 8 Regs -------------------------------------------------------------------*/
371
372 gran_block_8
373 {
374     Sp_adj(-8);
375     Sp(7) = R8;
376     Sp(6) = R7;
377     Sp(5) = R6;
378     Sp(4) = R5;
379     Sp(3) = R4;
380     Sp(2) = R3;
381     Sp(1) = R2;
382     Sp(0) = R1;
383     SAVE_THREAD_STATE();                                        
384     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
385     R1 = ThreadBlocked;
386     jump StgReturn;
387 }
388
389 #endif
390
391 #if 0 && defined(PAR)
392
393 /*
394   Similar to stg_block_1 (called via StgMacro BLOCK_NP) but separates the
395   saving of the thread state from the actual jump via an StgReturn.
396   We need this separation because we call RTS routines in blocking entry codes
397   before jumping back into the RTS (see parallel/FetchMe.hc).
398 */
399
400 par_block_1_no_jump
401 {
402     Sp_adj(-1);
403     Sp(0) = R1;
404     SAVE_THREAD_STATE();                                        
405 }
406
407 par_jump
408 {
409     TSO_what_next(CurrentTSO) = ThreadRunGHC;           
410     R1 = ThreadBlocked;
411     jump StgReturn;
412 }
413
414 #endif
415
416 /* -----------------------------------------------------------------------------
417    Heap checks in Primitive case alternatives
418
419    A primitive case alternative is entered with a value either in 
420    R1, FloatReg1 or D1 depending on the return convention.  All the
421    cases are covered below.
422    -------------------------------------------------------------------------- */
423
424 /*-- No Registers live ------------------------------------------------------ */
425
426 stg_gc_noregs
427 {
428     GC_GENERIC
429 }
430
431 /*-- void return ------------------------------------------------------------ */
432
433 INFO_TABLE_RET( stg_gc_void, RET_SMALL)
434 {
435     Sp_adj(1);
436     jump %ENTRY_CODE(Sp(0));
437 }
438
439 /*-- R1 is boxed/unpointed -------------------------------------------------- */
440
441 INFO_TABLE_RET( stg_gc_unpt_r1, RET_SMALL, "ptr" W_ unused)
442 {
443     R1 = Sp(1);
444     Sp_adj(2);
445     jump %ENTRY_CODE(Sp(0));
446 }
447
448 stg_gc_unpt_r1
449 {
450     Sp_adj(-2);
451     Sp(1) = R1;
452     Sp(0) = stg_gc_unpt_r1_info;
453     GC_GENERIC
454 }
455
456 /*-- R1 is unboxed -------------------------------------------------- */
457
458 /* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
459 INFO_TABLE_RET( stg_gc_unbx_r1, RET_SMALL, W_ unused )
460 {
461     R1 = Sp(1);
462     Sp_adj(2);
463     jump %ENTRY_CODE(Sp(0));
464 }
465
466 stg_gc_unbx_r1
467 {
468     Sp_adj(-2);
469     Sp(1) = R1;
470     Sp(0) = stg_gc_unbx_r1_info;
471     GC_GENERIC
472 }
473
474 /*-- F1 contains a float ------------------------------------------------- */
475
476 INFO_TABLE_RET( stg_gc_f1, RET_SMALL, F_ unused )
477 {
478     F1 = F_[Sp+WDS(1)];
479     Sp_adj(2);
480     jump %ENTRY_CODE(Sp(0));
481 }
482
483 stg_gc_f1
484 {
485     Sp_adj(-2);
486     F_[Sp + WDS(1)] = F1;
487     Sp(0) = stg_gc_f1_info;
488     GC_GENERIC
489 }
490
491 /*-- D1 contains a double ------------------------------------------------- */
492
493 INFO_TABLE_RET( stg_gc_d1, RET_SMALL, D_ unused )
494 {
495     D1 = D_[Sp + WDS(1)];
496     Sp = Sp + WDS(1) + SIZEOF_StgDouble;
497     jump %ENTRY_CODE(Sp(0));
498 }
499
500 stg_gc_d1
501 {
502     Sp = Sp - WDS(1) - SIZEOF_StgDouble;
503     D_[Sp + WDS(1)] = D1;
504     Sp(0) = stg_gc_d1_info;
505     GC_GENERIC
506 }
507
508
509 /*-- L1 contains an int64 ------------------------------------------------- */
510
511 INFO_TABLE_RET( stg_gc_l1, RET_SMALL, L_ unused )
512 {
513     L1 = L_[Sp + WDS(1)];
514     Sp_adj(1) + SIZEOF_StgWord64;
515     jump %ENTRY_CODE(Sp(0));
516 }
517
518 stg_gc_l1
519 {
520     Sp_adj(-1) - SIZEOF_StgWord64;
521     L_[Sp + WDS(1)] = L1;
522     Sp(0) = stg_gc_l1_info;
523     GC_GENERIC
524 }
525
526 /*-- Unboxed tuple return, one pointer (unregisterised build only) ---------- */
527
528 INFO_TABLE_RET( stg_ut_1_0_unreg, RET_SMALL, "ptr" W_ unused )
529 {
530     Sp_adj(1);
531     // one ptr is on the stack (Sp(0))
532     jump %ENTRY_CODE(Sp(1));
533 }
534
535 /* -----------------------------------------------------------------------------
536    Generic function entry heap check code.
537
538    At a function entry point, the arguments are as per the calling convention,
539    i.e. some in regs and some on the stack.  There may or may not be 
540    a pointer to the function closure in R1 - if there isn't, then the heap
541    check failure code in the function will arrange to load it.
542
543    The function's argument types are described in its info table, so we
544    can just jump to this bit of generic code to save away all the
545    registers and return to the scheduler.
546
547    This code arranges the stack like this:
548          
549          |        ....         |
550          |        args         |
551          +---------------------+
552          |      f_closure      |
553          +---------------------+
554          |         tag         |
555          +- - - - - - - - - - -+
556          |        size         |
557          +---------------------+
558          |   stg_gc_fun_info   |
559          +---------------------+
560
561    The size is the number of words of arguments on the stack, and is cached
562    in the frame in order to simplify stack walking: otherwise the size of
563    this stack frame would have to be calculated by looking at f's info table.
564
565    -------------------------------------------------------------------------- */
566
567 __stg_gc_fun
568 {
569     W_ size;
570     W_ info;
571     W_ type;
572     W_ tag;
573     W_ ret_fun;
574
575     tag  = GETTAG(R1);
576     info = %GET_FUN_INFO(UNTAG(R1));
577
578     // cache the size
579     type = TO_W_(StgFunInfoExtra_fun_type(info));
580     if (type == ARG_GEN) {
581         size = BITMAP_SIZE(StgFunInfoExtra_bitmap(info));
582     } else { 
583         if (type == ARG_GEN_BIG) {
584 #ifdef TABLES_NEXT_TO_CODE
585             // bitmap field holds an offset
586             size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info)
587                                         + %GET_ENTRY(UNTAG(R1)) /* ### */ );
588 #else
589             size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) );
590 #endif
591         } else {
592             size = BITMAP_SIZE(W_[stg_arg_bitmaps + WDS(type)]);
593         }
594     }
595     
596 #ifdef NO_ARG_REGS
597     // we don't have to save any registers away
598     Sp_adj(-3);
599     Sp(0) = stg_gc_fun_info;
600     ret_fun = Sp;
601     StgRetFun_size(ret_fun) = HALF_W_(size);
602     StgRetFun_tag(ret_fun)  = HALF_W_(tag);
603     StgRetFun_fun(ret_fun)  = R1;
604     GC_GENERIC
605 #else
606     W_ type;
607     type = TO_W_(StgFunInfoExtra_fun_type(info));
608     // cache the size
609     if (type == ARG_GEN || type == ARG_GEN_BIG) {
610         // regs already saved by the heap check code
611         Sp_adj(-3);
612         Sp(0) = stg_gc_fun_info;
613         ret_fun = Sp;
614         StgRetFun_size(ret_fun) = HALF_W_(size);
615         StgRetFun_tag(ret_fun)  = HALF_W_(tag);
616         StgRetFun_fun(ret_fun)  = R1;
617         // DEBUG_ONLY(foreign "C" debugBelch("stg_fun_gc_gen(ARG_GEN)"););
618         GC_GENERIC
619     } else { 
620         jump W_[stg_stack_save_entries + WDS(type)];
621             // jumps to stg_gc_noregs after saving stuff
622     }
623 #endif /* !NO_ARG_REGS */
624 }
625
626 /* -----------------------------------------------------------------------------
627    Generic Apply (return point)
628
629    The dual to stg_fun_gc_gen (above): this fragment returns to the
630    function, passing arguments in the stack and in registers
631    appropriately.  The stack layout is given above.
632    -------------------------------------------------------------------------- */
633
634 INFO_TABLE_RET( stg_gc_fun, RET_FUN )
635 {
636     // Grab the fun, but remember to add in the tag.  The GC doesn't
637     // guarantee to retain the tag on the pointer, so we have to do
638     // it manually, because the function entry code assumes it.
639     W_ ret_fun;
640     ret_fun = Sp;
641     R1 = StgRetFun_fun(ret_fun) | TO_W_(StgRetFun_tag(ret_fun));
642     Sp_adj(3);
643 #ifdef NO_ARG_REGS
644     // Minor optimisation: there are no argument registers to load up,
645     // so we can just jump straight to the function's entry point.
646     jump %GET_ENTRY(UNTAG(R1));
647 #else
648     W_ info;
649     W_ type;
650     
651     info = %GET_FUN_INFO(UNTAG(R1));
652     type = TO_W_(StgFunInfoExtra_fun_type(info));
653     if (type == ARG_GEN || type == ARG_GEN_BIG) {
654         jump StgFunInfoExtra_slow_apply(info);
655     } else { 
656         if (type == ARG_BCO) {
657             // cover this case just to be on the safe side
658             Sp_adj(-2);
659             Sp(1) = R1;
660             Sp(0) = stg_apply_interp_info;
661             jump stg_yield_to_interpreter;
662         } else {
663             jump W_[stg_ap_stack_entries + WDS(type)];
664         }
665     }
666 #endif
667 }
668
669 /* -----------------------------------------------------------------------------
670    Generic Heap Check Code.
671
672    Called with Liveness mask in R9,  Return address in R10.
673    Stack must be consistent (containing all necessary info pointers
674    to relevant SRTs).
675
676    See StgMacros.h for a description of the RET_DYN stack frame.
677
678    We also define an stg_gen_yield here, because it's very similar.
679    -------------------------------------------------------------------------- */
680
681 // For simplicity, we assume that SIZEOF_DOUBLE == 2*SIZEOF_VOID_P
682 // on a 64-bit machine, we'll end up wasting a couple of words, but
683 // it's not a big deal.
684
685 #define RESTORE_EVERYTHING                      \
686     L1   = L_[Sp + WDS(19)];                    \
687     D2   = D_[Sp + WDS(17)];                    \
688     D1   = D_[Sp + WDS(15)];                    \
689     F4   = F_[Sp + WDS(14)];                    \
690     F3   = F_[Sp + WDS(13)];                    \
691     F2   = F_[Sp + WDS(12)];                    \
692     F1   = F_[Sp + WDS(11)];                    \
693     R8 = Sp(10);                                \
694     R7 = Sp(9);                                 \
695     R6 = Sp(8);                                 \
696     R5 = Sp(7);                                 \
697     R4 = Sp(6);                                 \
698     R3 = Sp(5);                                 \
699     R2 = Sp(4);                                 \
700     R1 = Sp(3);                                 \
701     Sp_adj(21);
702
703 #define RET_OFFSET (-19)
704
705 #define SAVE_EVERYTHING                         \
706     Sp_adj(-21);                                \
707     L_[Sp + WDS(19)] = L1;                      \
708     D_[Sp + WDS(17)] = D2;                      \
709     D_[Sp + WDS(15)] = D1;                      \
710     F_[Sp + WDS(14)] = F4;                      \
711     F_[Sp + WDS(13)] = F3;                      \
712     F_[Sp + WDS(12)] = F2;                      \
713     F_[Sp + WDS(11)] = F1;                      \
714     Sp(10) = R8;                                \
715     Sp(9) = R7;                                 \
716     Sp(8) = R6;                                 \
717     Sp(7) = R5;                                 \
718     Sp(6) = R4;                                 \
719     Sp(5) = R3;                                 \
720     Sp(4) = R2;                                 \
721     Sp(3) = R1;                                 \
722     Sp(2) = R10;    /* return address */        \
723     Sp(1) = R9;     /* liveness mask  */        \
724     Sp(0) = stg_gc_gen_info;
725
726 INFO_TABLE_RET( stg_gc_gen, RET_DYN )
727 /* bitmap in the above info table is unused, the real one is on the stack. */
728 {
729     RESTORE_EVERYTHING;
730     jump Sp(RET_OFFSET); /* No %ENTRY_CODE( - this is an actual code ptr */
731 }
732
733 stg_gc_gen
734 {
735     SAVE_EVERYTHING;
736     GC_GENERIC
737 }         
738
739 // A heap check at an unboxed tuple return point.  The return address
740 // is on the stack, and we can find it by using the offsets given
741 // to us in the liveness mask.
742 stg_gc_ut
743 {
744     R10 = %ENTRY_CODE(Sp(RET_DYN_NONPTRS(R9) + RET_DYN_PTRS(R9)));
745     SAVE_EVERYTHING;
746     GC_GENERIC
747 }
748
749 /*
750  * stg_gen_hp is used by MAYBE_GC, where we can't use GC_GENERIC
751  * because we've just failed doYouWantToGC(), not a standard heap
752  * check.  GC_GENERIC would end up returning StackOverflow.
753  */
754 stg_gc_gen_hp
755 {
756     SAVE_EVERYTHING;
757     HP_GENERIC
758 }         
759
760 /* -----------------------------------------------------------------------------
761    Yields
762    -------------------------------------------------------------------------- */
763
764 stg_gen_yield
765 {
766     SAVE_EVERYTHING;
767     YIELD_GENERIC
768 }
769
770 stg_yield_noregs
771 {
772     YIELD_GENERIC;
773 }
774
775 /* -----------------------------------------------------------------------------
776    Yielding to the interpreter... top of stack says what to do next.
777    -------------------------------------------------------------------------- */
778
779 stg_yield_to_interpreter
780 {
781     YIELD_TO_INTERPRETER;
782 }
783
784 /* -----------------------------------------------------------------------------
785    Blocks
786    -------------------------------------------------------------------------- */
787
788 stg_gen_block
789 {
790     SAVE_EVERYTHING;
791     BLOCK_GENERIC;
792 }
793
794 stg_block_noregs
795 {
796     BLOCK_GENERIC;
797 }
798
799 stg_block_1
800 {
801     Sp_adj(-2);
802     Sp(1) = R1;
803     Sp(0) = stg_enter_info;
804     BLOCK_GENERIC;
805 }
806
807 /* -----------------------------------------------------------------------------
808  * takeMVar/putMVar-specific blocks
809  *
810  * Stack layout for a thread blocked in takeMVar:
811  *      
812  *       ret. addr
813  *       ptr to MVar   (R1)
814  *       stg_block_takemvar_info
815  *
816  * Stack layout for a thread blocked in putMVar:
817  *      
818  *       ret. addr
819  *       ptr to Value  (R2)
820  *       ptr to MVar   (R1)
821  *       stg_block_putmvar_info
822  *
823  * See PrimOps.hc for a description of the workings of take/putMVar.
824  * 
825  * -------------------------------------------------------------------------- */
826
827 INFO_TABLE_RET( stg_block_takemvar, RET_SMALL, "ptr" W_ unused )
828 {
829     R1 = Sp(1);
830     Sp_adj(2);
831     jump takeMVarzh_fast;
832 }
833
834 // code fragment executed just before we return to the scheduler
835 stg_block_takemvar_finally
836 {
837 #ifdef THREADED_RTS
838     unlockClosure(R3, stg_EMPTY_MVAR_info);
839 #endif
840     jump StgReturn;
841 }
842
843 stg_block_takemvar
844 {
845     Sp_adj(-2);
846     Sp(1) = R1;
847     Sp(0) = stg_block_takemvar_info;
848     R3 = R1;
849     BLOCK_BUT_FIRST(stg_block_takemvar_finally);
850 }
851
852 INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, "ptr" W_ unused1, "ptr" W_ unused2 )
853 {
854     R2 = Sp(2);
855     R1 = Sp(1);
856     Sp_adj(3);
857     jump putMVarzh_fast;
858 }
859
860 // code fragment executed just before we return to the scheduler
861 stg_block_putmvar_finally
862 {
863 #ifdef THREADED_RTS
864     unlockClosure(R3, stg_FULL_MVAR_info);
865 #endif
866     jump StgReturn;
867 }
868
869 stg_block_putmvar
870 {
871     Sp_adj(-3);
872     Sp(2) = R2;
873     Sp(1) = R1;
874     Sp(0) = stg_block_putmvar_info;
875     R3 = R1;
876     BLOCK_BUT_FIRST(stg_block_putmvar_finally);
877 }
878
879 // code fragment executed just before we return to the scheduler
880 stg_block_blackhole_finally
881 {
882 #if defined(THREADED_RTS)
883     // The last thing we do is release sched_lock, which is
884     // preventing other threads from accessing blackhole_queue and
885     // picking up this thread before we are finished with it.
886     foreign "C" RELEASE_LOCK(sched_mutex "ptr");
887 #endif
888     jump StgReturn;
889 }
890
891 stg_block_blackhole
892 {
893     Sp_adj(-2);
894     Sp(1) = R1;
895     Sp(0) = stg_enter_info;
896     BLOCK_BUT_FIRST(stg_block_blackhole_finally);
897 }
898
899 INFO_TABLE_RET( stg_block_throwto, RET_SMALL, "ptr" W_ unused, "ptr" W_ unused )
900 {
901     R2 = Sp(2);
902     R1 = Sp(1);
903     Sp_adj(3);
904     jump killThreadzh_fast;
905 }
906
907 stg_block_throwto_finally
908 {
909 #ifdef THREADED_RTS
910     foreign "C" throwToReleaseTarget (R3 "ptr");
911 #endif
912     jump StgReturn;
913 }
914
915 stg_block_throwto
916 {
917     Sp_adj(-3);
918     Sp(2) = R2;
919     Sp(1) = R1;
920     Sp(0) = stg_block_throwto_info;
921     BLOCK_BUT_FIRST(stg_block_throwto_finally);
922 }
923
924 #ifdef mingw32_HOST_OS
925 INFO_TABLE_RET( stg_block_async, RET_SMALL )
926 {
927     W_ ares;
928     W_ len, errC;
929
930     ares = StgTSO_block_info(CurrentTSO);
931     len = StgAsyncIOResult_len(ares);
932     errC = StgAsyncIOResult_errCode(ares);
933     StgTSO_block_info(CurrentTSO) = NULL;
934     foreign "C" free(ares "ptr");
935     R1 = len;
936     Sp(0) = errC;
937     jump %ENTRY_CODE(Sp(1));
938 }
939
940 stg_block_async
941 {
942     Sp_adj(-1);
943     Sp(0) = stg_block_async_info;
944     BLOCK_GENERIC;
945 }
946
947 /* Used by threadDelay implementation; it would be desirable to get rid of
948  * this free()'ing void return continuation.
949  */
950 INFO_TABLE_RET( stg_block_async_void, RET_SMALL )
951 {
952     W_ ares;
953
954     ares = StgTSO_block_info(CurrentTSO);
955     StgTSO_block_info(CurrentTSO) = NULL;
956     foreign "C" free(ares "ptr");
957     Sp_adj(1);
958     jump %ENTRY_CODE(Sp(0));
959 }
960
961 stg_block_async_void
962 {
963     Sp_adj(-1);
964     Sp(0) = stg_block_async_void_info;
965     BLOCK_GENERIC;
966 }
967
968 #endif
969
970 /* -----------------------------------------------------------------------------
971    STM-specific waiting
972    -------------------------------------------------------------------------- */
973
974 stg_block_stmwait_finally
975 {
976     foreign "C" stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
977     jump StgReturn;
978 }
979
980 stg_block_stmwait
981 {
982     BLOCK_BUT_FIRST(stg_block_stmwait_finally);
983 }