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