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