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