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