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