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