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, W_ unused )
 666 {
 667     W_ ares;
 668     W_ len, errC;
 669
 670     ares = Sp(1);
 671     len = StgAsyncIOResult_len(ares);
 672     errC = StgAsyncIOResult_errCode(ares);
 673     foreign "C" free(ares "ptr");
 674     R1 = len;
 675     Sp_adj(1);
 676     Sp(0) = errC;
 677     jump %ENTRY_CODE(Sp(1));
 678 }
 679
 680 stg_block_async
 681 {
 682     Sp_adj(-2);
 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, W_ ares )
 691 {
 692     W_ ares;
 693
 694     ares = Sp(1);
 695     foreign "C" free(ares "ptr");
 696     Sp_adj(2);
 697     jump %ENTRY_CODE(Sp(0));
 698 }
 699
 700 stg_block_async_void
 701 {
 702     Sp_adj(-2);
 703     Sp(0) = stg_block_async_void_info;
 704     BLOCK_GENERIC;
 705 }
 706
 707 #endif
 708
 709 /* -----------------------------------------------------------------------------
 710    STM-specific waiting
 711    -------------------------------------------------------------------------- */
 712
 713 stg_block_stmwait_finally
 714 {
 715     foreign "C" stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
 716     jump StgReturn;
 717 }
 718
 719 stg_block_stmwait
 720 {
 721     BLOCK_BUT_FIRST(stg_block_stmwait_finally);
 722 }