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