ghc/rts/HeapStackCheck.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: HeapStackCheck.hc,v 1.20 2001/12/10 17:55:40 sewardj Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Canned Heap-Check and Stack-Check sequences.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Stg.h"
  11 #include "Rts.h"
  12 #include "Storage.h"    /* for CurrentTSO */
  13 #include "StgRun.h"     /* for StgReturn and register saving */
  14 #include "Schedule.h"   /* for context_switch */
  15
  16 /* Stack/Heap Check Failure
  17  * ------------------------
  18  *
  19  * On discovering that a stack or heap check has failed, we do the following:
  20  *
  21  *    - If the context_switch flag is set, indicating that there are more
  22  *      threads waiting to run, we yield to the scheduler
  23  *      (return ThreadYielding).
  24  *
  25  *    - If Hp > HpLim, we've had a heap check failure.  This means we've
  26  *      come to the end of the current heap block, so we try to chain
  27  *      another block on with ExtendNursery().
  28  *
  29  *           - If this succeeds, we carry on without returning to the
  30  *             scheduler.
  31  *
  32  *           - If it fails, we return to the scheduler claiming HeapOverflow
  33  *             so that a garbage collection can be performed.
  34  *
  35  *    - If Hp <= HpLim, it must have been a stack check that failed.  In
  36  *      which case, we return to the scheduler claiming StackOverflow, the
  37  *      scheduler will either increase the size of our stack, or flag
  38  *      an error if the stack is already too big.
  39  *
  40  * The effect of checking for context switch only in the heap/stack check
  41  * failure code is that we'll switch threads after the current thread has
  42  * reached the end of its heap block.  If a thread isn't allocating
  43  * at all, it won't yield.  Hopefully this won't be a problem in practice.
  44  */
  45
  46 /* Remember that the return address is *removed* when returning to a
  47  * ThreadRunGHC thread.
  48  */
  49
  50 #define GC_GENERIC                                      \
  51   if (Hp > HpLim) {                                     \
  52     Hp -= HpAlloc;                                      \
  53     if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
  54         if (context_switch) {                           \
  55             R1.i = ThreadYielding;                      \
  56         } else {                                        \
  57            Sp++;                                        \
  58            JMP_(ENTRY_CODE(Sp[-1]));                    \
  59         }                                               \
  60     } else {                                            \
  61       R1.i = HeapOverflow;                              \
  62     }                                                   \
  63   } else {                                              \
  64     R1.i = StackOverflow;                               \
  65   }                                                     \
  66   SaveThreadState();                                    \
  67   CurrentTSO->what_next = ThreadRunGHC;                 \
  68   JMP_(StgReturn);
  69
  70 #define GC_ENTER                                        \
  71   if (Hp > HpLim) {                                     \
  72     Hp -= HpAlloc;                                      \
  73     if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
  74         if (context_switch) {                           \
  75             R1.i = ThreadYielding;                      \
  76         } else {                                        \
  77            R1.w = *Sp;                                  \
  78            Sp++;                                        \
  79            JMP_(ENTRY_CODE(*R1.p));                     \
  80         }                                               \
  81     } else {                                            \
  82       R1.i = HeapOverflow;                              \
  83     }                                                   \
  84   } else {                                              \
  85     R1.i = StackOverflow;                               \
  86   }                                                     \
  87   SaveThreadState();                                    \
  88   CurrentTSO->what_next = ThreadEnterGHC;               \
  89   JMP_(StgReturn);
  90
  91 #define HP_GENERIC                      \
  92   SaveThreadState();                    \
  93   CurrentTSO->what_next = ThreadRunGHC; \
  94   R1.i = HeapOverflow;                  \
  95   JMP_(StgReturn);
  96
  97 #define STK_GENERIC                     \
  98   SaveThreadState();                    \
  99   CurrentTSO->what_next = ThreadRunGHC; \
 100   R1.i = StackOverflow;                 \
 101   JMP_(StgReturn);
 102
 103 #define YIELD_GENERIC                   \
 104   SaveThreadState();                    \
 105   CurrentTSO->what_next = ThreadRunGHC; \
 106   R1.i = ThreadYielding;                \
 107   JMP_(StgReturn);
 108
 109 #define YIELD_TO_INTERPRETER              \
 110   SaveThreadState();                      \
 111   CurrentTSO->what_next = ThreadEnterInterp; \
 112   R1.i = ThreadYielding;                  \
 113   JMP_(StgReturn);
 114
 115 #define BLOCK_GENERIC                   \
 116   SaveThreadState();                    \
 117   CurrentTSO->what_next = ThreadRunGHC; \
 118   R1.i = ThreadBlocked;                 \
 119   JMP_(StgReturn);
 120
 121 #define BLOCK_ENTER                     \
 122   SaveThreadState();                    \
 123   CurrentTSO->what_next = ThreadEnterGHC;\
 124   R1.i = ThreadBlocked;                 \
 125   JMP_(StgReturn);
 126
 127 /* -----------------------------------------------------------------------------
 128    Heap Checks
 129    -------------------------------------------------------------------------- */
 130
 131 /*
 132  * This one is used when we want to *enter* the top thing on the stack
 133  * when we return, instead of the just returning to an address.  See
 134  * UpdatePAP for an example.
 135  */
 136
 137 EXTFUN(stg_gc_entertop)
 138 {
 139   FB_
 140   GC_ENTER
 141   FE_
 142 }
 143
 144 /* -----------------------------------------------------------------------------
 145    Heap checks in non-top-level thunks/functions.
 146
 147    In these cases, node always points to the function closure.  This gives
 148    us an easy way to return to the function: just leave R1 on the top of
 149    the stack, and have the scheduler enter it to return.
 150
 151    There are canned sequences for 'n' pointer values in registers.
 152    -------------------------------------------------------------------------- */
 153
 154 EXTFUN(__stg_gc_enter_1)
 155 {
 156   FB_
 157   Sp -= 1;
 158   Sp[0] = R1.w;
 159   GC_ENTER
 160   FE_
 161 }
 162
 163 EXTFUN(stg_gc_enter_1_hponly)
 164 {
 165   FB_
 166   Sp -= 1;
 167   Sp[0] = R1.w;
 168   R1.i = HeapOverflow;
 169   SaveThreadState();
 170   CurrentTSO->what_next = ThreadEnterGHC;
 171   JMP_(StgReturn);
 172   FE_
 173 }
 174
 175 /*- 2 Regs--------------------------------------------------------------------*/
 176
 177 EXTFUN(stg_gc_enter_2)
 178 {
 179   FB_
 180   Sp -= 2;
 181   Sp[1] = R2.w;
 182   Sp[0] = R1.w;
 183   GC_ENTER;
 184   FE_
 185 }
 186
 187 /*- 3 Regs -------------------------------------------------------------------*/
 188
 189 EXTFUN(stg_gc_enter_3)
 190 {
 191   FB_
 192   Sp -= 3;
 193   Sp[2] = R3.w;
 194   Sp[1] = R2.w;
 195   Sp[0] = R1.w;
 196   GC_ENTER;
 197   FE_
 198 }
 199
 200 /*- 4 Regs -------------------------------------------------------------------*/
 201
 202 EXTFUN(stg_gc_enter_4)
 203 {
 204   FB_
 205   Sp -= 4;
 206   Sp[3] = R4.w;
 207   Sp[2] = R3.w;
 208   Sp[1] = R2.w;
 209   Sp[0] = R1.w;
 210   GC_ENTER;
 211   FE_
 212 }
 213
 214 /*- 5 Regs -------------------------------------------------------------------*/
 215
 216 EXTFUN(stg_gc_enter_5)
 217 {
 218   FB_
 219   Sp -= 5;
 220   Sp[4] = R5.w;
 221   Sp[3] = R4.w;
 222   Sp[2] = R3.w;
 223   Sp[1] = R2.w;
 224   Sp[0] = R1.w;
 225   GC_ENTER;
 226   FE_
 227 }
 228
 229 /*- 6 Regs -------------------------------------------------------------------*/
 230
 231 EXTFUN(stg_gc_enter_6)
 232 {
 233   FB_
 234   Sp -= 6;
 235   Sp[5] = R6.w;
 236   Sp[4] = R5.w;
 237   Sp[3] = R4.w;
 238   Sp[2] = R3.w;
 239   Sp[1] = R2.w;
 240   Sp[0] = R1.w;
 241   GC_ENTER;
 242   FE_
 243 }
 244
 245 /*- 7 Regs -------------------------------------------------------------------*/
 246
 247 EXTFUN(stg_gc_enter_7)
 248 {
 249   FB_
 250   Sp -= 7;
 251   Sp[6] = R7.w;
 252   Sp[5] = R6.w;
 253   Sp[4] = R5.w;
 254   Sp[3] = R4.w;
 255   Sp[2] = R3.w;
 256   Sp[1] = R2.w;
 257   Sp[0] = R1.w;
 258   GC_ENTER;
 259   FE_
 260 }
 261
 262 /*- 8 Regs -------------------------------------------------------------------*/
 263
 264 EXTFUN(stg_gc_enter_8)
 265 {
 266   FB_
 267   Sp -= 8;
 268   Sp[7] = R8.w;
 269   Sp[6] = R7.w;
 270   Sp[5] = R6.w;
 271   Sp[4] = R5.w;
 272   Sp[3] = R4.w;
 273   Sp[2] = R3.w;
 274   Sp[1] = R2.w;
 275   Sp[0] = R1.w;
 276   GC_ENTER;
 277   FE_
 278 }
 279
 280 #if defined(GRAN)
 281 /*
 282   ToDo: merge the block and yield macros, calling something like BLOCK(N)
 283         at the end;
 284 */
 285
 286 /*
 287    Should we actually ever do a yield in such a case?? -- HWL
 288 */
 289 EXTFUN(gran_yield_0)
 290 {
 291   FB_
 292   SaveThreadState();
 293   CurrentTSO->what_next = ThreadEnterGHC;
 294   R1.i = ThreadYielding;
 295   JMP_(StgReturn);
 296   FE_
 297 }
 298
 299 EXTFUN(gran_yield_1)
 300 {
 301   FB_
 302   Sp -= 1;
 303   Sp[0] = R1.w;
 304   SaveThreadState();
 305   CurrentTSO->what_next = ThreadEnterGHC;
 306   R1.i = ThreadYielding;
 307   JMP_(StgReturn);
 308   FE_
 309 }
 310
 311 /*- 2 Regs--------------------------------------------------------------------*/
 312
 313 EXTFUN(gran_yield_2)
 314 {
 315   FB_
 316   Sp -= 2;
 317   Sp[1] = R2.w;
 318   Sp[0] = R1.w;
 319   SaveThreadState();
 320   CurrentTSO->what_next = ThreadEnterGHC;
 321   R1.i = ThreadYielding;
 322   JMP_(StgReturn);
 323   FE_
 324 }
 325
 326 /*- 3 Regs -------------------------------------------------------------------*/
 327
 328 EXTFUN(gran_yield_3)
 329 {
 330   FB_
 331   Sp -= 3;
 332   Sp[2] = R3.w;
 333   Sp[1] = R2.w;
 334   Sp[0] = R1.w;
 335   SaveThreadState();
 336   CurrentTSO->what_next = ThreadEnterGHC;
 337   R1.i = ThreadYielding;
 338   JMP_(StgReturn);
 339   FE_
 340 }
 341
 342 /*- 4 Regs -------------------------------------------------------------------*/
 343
 344 EXTFUN(gran_yield_4)
 345 {
 346   FB_
 347   Sp -= 4;
 348   Sp[3] = R4.w;
 349   Sp[2] = R3.w;
 350   Sp[1] = R2.w;
 351   Sp[0] = R1.w;
 352   SaveThreadState();
 353   CurrentTSO->what_next = ThreadEnterGHC;
 354   R1.i = ThreadYielding;
 355   JMP_(StgReturn);
 356   FE_
 357 }
 358
 359 /*- 5 Regs -------------------------------------------------------------------*/
 360
 361 EXTFUN(gran_yield_5)
 362 {
 363   FB_
 364   Sp -= 5;
 365   Sp[4] = R5.w;
 366   Sp[3] = R4.w;
 367   Sp[2] = R3.w;
 368   Sp[1] = R2.w;
 369   Sp[0] = R1.w;
 370   SaveThreadState();
 371   CurrentTSO->what_next = ThreadEnterGHC;
 372   R1.i = ThreadYielding;
 373   JMP_(StgReturn);
 374   FE_
 375 }
 376
 377 /*- 6 Regs -------------------------------------------------------------------*/
 378
 379 EXTFUN(gran_yield_6)
 380 {
 381   FB_
 382   Sp -= 6;
 383   Sp[5] = R6.w;
 384   Sp[4] = R5.w;
 385   Sp[3] = R4.w;
 386   Sp[2] = R3.w;
 387   Sp[1] = R2.w;
 388   Sp[0] = R1.w;
 389   SaveThreadState();
 390   CurrentTSO->what_next = ThreadEnterGHC;
 391   R1.i = ThreadYielding;
 392   JMP_(StgReturn);
 393   FE_
 394 }
 395
 396 /*- 7 Regs -------------------------------------------------------------------*/
 397
 398 EXTFUN(gran_yield_7)
 399 {
 400   FB_
 401   Sp -= 7;
 402   Sp[6] = R7.w;
 403   Sp[5] = R6.w;
 404   Sp[4] = R5.w;
 405   Sp[3] = R4.w;
 406   Sp[2] = R3.w;
 407   Sp[1] = R2.w;
 408   Sp[0] = R1.w;
 409   SaveThreadState();
 410   CurrentTSO->what_next = ThreadEnterGHC;
 411   R1.i = ThreadYielding;
 412   JMP_(StgReturn);
 413   FE_
 414 }
 415
 416 /*- 8 Regs -------------------------------------------------------------------*/
 417
 418 EXTFUN(gran_yield_8)
 419 {
 420   FB_
 421   Sp -= 8;
 422   Sp[7] = R8.w;
 423   Sp[6] = R7.w;
 424   Sp[5] = R6.w;
 425   Sp[4] = R5.w;
 426   Sp[3] = R4.w;
 427   Sp[2] = R3.w;
 428   Sp[1] = R2.w;
 429   Sp[0] = R1.w;
 430   SaveThreadState();
 431   CurrentTSO->what_next = ThreadEnterGHC;
 432   R1.i = ThreadYielding;
 433   JMP_(StgReturn);
 434   FE_
 435 }
 436
 437 // the same routines but with a block rather than a yield
 438
 439 EXTFUN(gran_block_1)
 440 {
 441   FB_
 442   Sp -= 1;
 443   Sp[0] = R1.w;
 444   SaveThreadState();
 445   CurrentTSO->what_next = ThreadEnterGHC;
 446   R1.i = ThreadBlocked;
 447   JMP_(StgReturn);
 448   FE_
 449 }
 450
 451 /*- 2 Regs--------------------------------------------------------------------*/
 452
 453 EXTFUN(gran_block_2)
 454 {
 455   FB_
 456   Sp -= 2;
 457   Sp[1] = R2.w;
 458   Sp[0] = R1.w;
 459   SaveThreadState();
 460   CurrentTSO->what_next = ThreadEnterGHC;
 461   R1.i = ThreadBlocked;
 462   JMP_(StgReturn);
 463   FE_
 464 }
 465
 466 /*- 3 Regs -------------------------------------------------------------------*/
 467
 468 EXTFUN(gran_block_3)
 469 {
 470   FB_
 471   Sp -= 3;
 472   Sp[2] = R3.w;
 473   Sp[1] = R2.w;
 474   Sp[0] = R1.w;
 475   SaveThreadState();
 476   CurrentTSO->what_next = ThreadEnterGHC;
 477   R1.i = ThreadBlocked;
 478   JMP_(StgReturn);
 479   FE_
 480 }
 481
 482 /*- 4 Regs -------------------------------------------------------------------*/
 483
 484 EXTFUN(gran_block_4)
 485 {
 486   FB_
 487   Sp -= 4;
 488   Sp[3] = R4.w;
 489   Sp[2] = R3.w;
 490   Sp[1] = R2.w;
 491   Sp[0] = R1.w;
 492   SaveThreadState();
 493   CurrentTSO->what_next = ThreadEnterGHC;
 494   R1.i = ThreadBlocked;
 495   JMP_(StgReturn);
 496   FE_
 497 }
 498
 499 /*- 5 Regs -------------------------------------------------------------------*/
 500
 501 EXTFUN(gran_block_5)
 502 {
 503   FB_
 504   Sp -= 5;
 505   Sp[4] = R5.w;
 506   Sp[3] = R4.w;
 507   Sp[2] = R3.w;
 508   Sp[1] = R2.w;
 509   Sp[0] = R1.w;
 510   SaveThreadState();
 511   CurrentTSO->what_next = ThreadEnterGHC;
 512   R1.i = ThreadBlocked;
 513   JMP_(StgReturn);
 514   FE_
 515 }
 516
 517 /*- 6 Regs -------------------------------------------------------------------*/
 518
 519 EXTFUN(gran_block_6)
 520 {
 521   FB_
 522   Sp -= 6;
 523   Sp[5] = R6.w;
 524   Sp[4] = R5.w;
 525   Sp[3] = R4.w;
 526   Sp[2] = R3.w;
 527   Sp[1] = R2.w;
 528   Sp[0] = R1.w;
 529   SaveThreadState();
 530   CurrentTSO->what_next = ThreadEnterGHC;
 531   R1.i = ThreadBlocked;
 532   JMP_(StgReturn);
 533   FE_
 534 }
 535
 536 /*- 7 Regs -------------------------------------------------------------------*/
 537
 538 EXTFUN(gran_block_7)
 539 {
 540   FB_
 541   Sp -= 7;
 542   Sp[6] = R7.w;
 543   Sp[5] = R6.w;
 544   Sp[4] = R5.w;
 545   Sp[3] = R4.w;
 546   Sp[2] = R3.w;
 547   Sp[1] = R2.w;
 548   Sp[0] = R1.w;
 549   SaveThreadState();
 550   CurrentTSO->what_next = ThreadEnterGHC;
 551   R1.i = ThreadBlocked;
 552   JMP_(StgReturn);
 553   FE_
 554 }
 555
 556 /*- 8 Regs -------------------------------------------------------------------*/
 557
 558 EXTFUN(gran_block_8)
 559 {
 560   FB_
 561   Sp -= 8;
 562   Sp[7] = R8.w;
 563   Sp[6] = R7.w;
 564   Sp[5] = R6.w;
 565   Sp[4] = R5.w;
 566   Sp[3] = R4.w;
 567   Sp[2] = R3.w;
 568   Sp[1] = R2.w;
 569   Sp[0] = R1.w;
 570   SaveThreadState();
 571   CurrentTSO->what_next = ThreadEnterGHC;
 572   R1.i = ThreadBlocked;
 573   JMP_(StgReturn);
 574   FE_
 575 }
 576
 577 #endif
 578
 579 #if 0 && defined(PAR)
 580
 581 /*
 582   Similar to stg_block_1 (called via StgMacro BLOCK_NP) but separates the
 583   saving of the thread state from the actual jump via an StgReturn.
 584   We need this separation because we call RTS routines in blocking entry codes
 585   before jumping back into the RTS (see parallel/FetchMe.hc).
 586 */
 587
 588 EXTFUN(par_block_1_no_jump)
 589 {
 590   FB_
 591   Sp -= 1;
 592   Sp[0] = R1.w;
 593   SaveThreadState();
 594   FE_
 595 }
 596
 597 EXTFUN(par_jump)
 598 {
 599   FB_
 600   CurrentTSO->what_next = ThreadEnterGHC;
 601   R1.i = ThreadBlocked;
 602   JMP_(StgReturn);
 603   FE_
 604 }
 605
 606 #endif
 607
 608 /* -----------------------------------------------------------------------------
 609    For a case expression on a polymorphic or function-typed object, if
 610    the default branch (there can only be one branch) of the case fails
 611    a heap-check, instead of using stg_gc_enter_1 as normal, we must
 612    push a new SEQ frame on the stack, followed by the object returned.
 613
 614    Otherwise, if the object is a function, it won't return to the
 615    correct activation record on returning from garbage collection.  It will
 616    assume it has some arguments and apply itself.
 617    -------------------------------------------------------------------------- */
 618
 619 EXTFUN(stg_gc_seq_1)
 620 {
 621   FB_
 622   Sp -= 1 + sizeofW(StgSeqFrame);
 623   PUSH_SEQ_FRAME(Sp+1);
 624   *Sp = R1.w;
 625   GC_ENTER;
 626   FE_
 627 }
 628
 629 /* -----------------------------------------------------------------------------
 630    Heap checks in Primitive case alternatives
 631
 632    A primitive case alternative is entered with a value either in
 633    R1, FloatReg1 or D1 depending on the return convention.  All the
 634    cases are covered below.
 635    -------------------------------------------------------------------------- */
 636
 637 /*-- No regsiters live (probably a void return) ----------------------------- */
 638
 639 /* If we change the policy for thread startup to *not* remove the
 640  * return address from the stack, we can get rid of this little
 641  * function/info table...
 642  */
 643 INFO_TABLE_SRT_BITMAP(stg_gc_noregs_ret_info, stg_gc_noregs_ret, 0/*BITMAP*/,
 644                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 645                       RET_SMALL,, EF_, 0, 0);
 646
 647 EXTFUN(stg_gc_noregs_ret)
 648 {
 649   FB_
 650   JMP_(ENTRY_CODE(Sp[0]));
 651   FE_
 652 }
 653
 654 EXTFUN(stg_gc_noregs)
 655 {
 656   FB_
 657   Sp -= 1;
 658   Sp[0] = (W_)&stg_gc_noregs_ret_info;
 659   GC_GENERIC
 660   FE_
 661 }
 662
 663 /*-- R1 is boxed/unpointed -------------------------------------------------- */
 664
 665 INFO_TABLE_SRT_BITMAP(stg_gc_unpt_r1_ret_info, stg_gc_unpt_r1_ret, 0/*BITMAP*/,
 666                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 667                       RET_SMALL,, EF_, 0, 0);
 668
 669 EXTFUN(stg_gc_unpt_r1_ret)
 670 {
 671   FB_
 672   R1.w = Sp[0];
 673   Sp += 1;
 674   JMP_(ENTRY_CODE(Sp[0]));
 675   FE_
 676 }
 677
 678 EXTFUN(stg_gc_unpt_r1)
 679 {
 680   FB_
 681   Sp -= 2;
 682   Sp[1] = R1.w;
 683   Sp[0] = (W_)&stg_gc_unpt_r1_ret_info;
 684   GC_GENERIC
 685   FE_
 686 }
 687
 688 /*-- R1 is unboxed -------------------------------------------------- */
 689
 690 INFO_TABLE_SRT_BITMAP(stg_gc_unbx_r1_ret_info, stg_gc_unbx_r1_ret, 1/*BITMAP*/,
 691                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 692                       RET_SMALL,, EF_, 0, 0);
 693 /* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
 694
 695 EXTFUN(stg_gc_unbx_r1_ret)
 696 {
 697   FB_
 698   R1.w = Sp[0];
 699   Sp += 1;
 700   JMP_(ENTRY_CODE(Sp[0]));
 701   FE_
 702 }
 703
 704 EXTFUN(stg_gc_unbx_r1)
 705 {
 706   FB_
 707   Sp -= 2;
 708   Sp[1] = R1.w;
 709   Sp[0] = (W_)&stg_gc_unbx_r1_ret;
 710   GC_GENERIC
 711   FE_
 712 }
 713
 714 /*-- F1 contains a float ------------------------------------------------- */
 715
 716 INFO_TABLE_SRT_BITMAP(stg_gc_f1_ret_info, stg_gc_f1_ret, 1/*BITMAP*/,
 717                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 718                       RET_SMALL,, EF_, 0, 0);
 719
 720 EXTFUN(stg_gc_f1_ret)
 721 {
 722   FB_
 723   F1 = PK_FLT(Sp);
 724   Sp += 1;
 725   JMP_(ENTRY_CODE(Sp[0]));
 726   FE_
 727 }
 728
 729 EXTFUN(stg_gc_f1)
 730 {
 731   FB_
 732   Sp -= 2;
 733   ASSIGN_FLT(Sp+1, F1);
 734   Sp[0] = (W_)&stg_gc_f1_ret_info;
 735   GC_GENERIC
 736   FE_
 737 }
 738
 739 /*-- D1 contains a double ------------------------------------------------- */
 740
 741 /* we support doubles of either 1 or 2 words in size */
 742
 743 #if SIZEOF_DOUBLE == SIZEOF_VOID_P
 744 #  define DBL_BITMAP 1
 745 #else
 746 #  define DBL_BITMAP 3
 747 #endif
 748
 749 INFO_TABLE_SRT_BITMAP(stg_gc_d1_ret_info, stg_gc_d1_ret, DBL_BITMAP,
 750                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 751                       RET_SMALL,, EF_, 0, 0);
 752
 753 EXTFUN(stg_gc_d1_ret)
 754 {
 755   FB_
 756   D1 = PK_DBL(Sp);
 757   Sp += sizeofW(StgDouble);
 758   JMP_(ENTRY_CODE(Sp[0]));
 759   FE_
 760 }
 761
 762 EXTFUN(stg_gc_d1)
 763 {
 764   FB_
 765   Sp -= 1 + sizeofW(StgDouble);
 766   ASSIGN_DBL(Sp+1,D1);
 767   Sp[0] = (W_)&stg_gc_d1_ret_info;
 768   GC_GENERIC
 769   FE_
 770 }
 771
 772 /*-- L1 contains an int64 ------------------------------------------------- */
 773
 774 /* we support int64s of either 1 or 2 words in size */
 775
 776 #if SIZEOF_VOID_P == 8
 777 #  define LLI_BITMAP 1
 778 #else
 779 #  define LLI_BITMAP 3
 780 #endif
 781
 782 INFO_TABLE_SRT_BITMAP(stg_gc_l1_ret_info, stg_gc_l1_ret, LLI_BITMAP,
 783                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 784                       RET_SMALL,, EF_, 0, 0);
 785
 786 EXTFUN(stg_gc_l1_ret)
 787 {
 788   FB_
 789   L1 = PK_Int64(Sp);
 790   Sp += sizeofW(StgWord64);
 791   JMP_(ENTRY_CODE(Sp[0]));
 792   FE_
 793 }
 794
 795 EXTFUN(stg_gc_l1)
 796 {
 797   FB_
 798   Sp -= 1 + sizeofW(StgWord64);
 799   ASSIGN_Int64(Sp+1,L1);
 800   Sp[0] = (W_)&stg_gc_l1_ret_info;
 801   GC_GENERIC
 802   FE_
 803 }
 804
 805 /* -----------------------------------------------------------------------------
 806    Heap checks for unboxed tuple case alternatives
 807
 808    The story is:
 809
 810       - for an unboxed tuple with n components, we rearrange the components
 811         with pointers first followed by non-pointers. (NB: not done yet)
 812
 813       - The first k components are allocated registers, where k is the
 814         number of components that will fit in real registers.
 815
 816       - The rest are placed on the stack, with space left for tagging
 817         of the non-pointer block if necessary.
 818
 819       - On failure of a heap check:
 820                 - the tag is filled in if necessary,
 821                 - we load Ri with the address of the continuation,
 822                   where i is the lowest unused vanilla register.
 823                 - jump to 'stg_gc_ut_x_y' where x is the number of pointer
 824                   registers and y the number of non-pointers.
 825                 - if the required canned sequence isn't available, it will
 826                   have to be generated at compile-time by the code
 827                   generator (this will probably happen if there are
 828                   floating-point values, for instance).
 829
 830    For now, just deal with R1, hence R2 contains the sequel address.
 831    -------------------------------------------------------------------------- */
 832
 833 /*---- R1 contains a pointer: ------ */
 834
 835 INFO_TABLE_SRT_BITMAP(stg_gc_ut_1_0_ret_info, stg_gc_ut_1_0_ret, 1/*BITMAP*/,
 836                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 837                       RET_SMALL,, EF_, 0, 0);
 838
 839 EXTFUN(stg_gc_ut_1_0_ret)
 840 {
 841   FB_
 842   R1.w = Sp[1];
 843   Sp += 2;
 844   JMP_(ENTRY_CODE(Sp[-2]));
 845   FE_
 846 }
 847
 848 EXTFUN(stg_gc_ut_1_0)
 849 {
 850   FB_
 851   Sp -= 3;
 852   Sp[2] = R1.w;
 853   Sp[1] = R2.w;
 854   Sp[0] = (W_)&stg_gc_ut_1_0_ret_info;
 855   GC_GENERIC
 856   FE_
 857 }
 858
 859 /*---- R1 contains a non-pointer: ------ */
 860
 861 INFO_TABLE_SRT_BITMAP(stg_gc_ut_0_1_ret_info, stg_gc_ut_0_1_ret, 3/*BITMAP*/,
 862                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 863                       RET_SMALL,, EF_, 0, 0);
 864
 865 EXTFUN(stg_gc_ut_0_1_ret)
 866 {
 867   FB_
 868   R1.w = Sp[1];
 869   Sp += 2;
 870   JMP_(ENTRY_CODE(Sp[-2]));
 871   FE_
 872 }
 873
 874 EXTFUN(stg_gc_ut_0_1)
 875 {
 876   FB_
 877   Sp -= 3;
 878   Sp[0] = (W_)&stg_gc_ut_0_1_ret_info;
 879   Sp[1] = R2.w;
 880   Sp[2] = R1.w;
 881   GC_GENERIC
 882   FE_
 883 }
 884
 885 /* -----------------------------------------------------------------------------
 886    Standard top-level fast-entry heap checks.
 887
 888    - we want to make the stack look like it should at the slow entry
 889      point for the function.  That way we can just push the slow
 890      entry point on the stack and return using ThreadRunGHC.
 891
 892    - The compiler will generate code to fill in any tags on the stack,
 893      in case we arrived directly at the fast entry point and these tags
 894      aren't present.
 895
 896    - The rest is hopefully handled by jumping to a canned sequence.
 897      We currently have canned sequences for 0-8 pointer registers.  If
 898      any registers contain non-pointers, we must reduce to an all-pointers
 899      situation by pushing as many registers on the stack as necessary.
 900
 901      eg. if R1, R2 contain pointers and R3 contains a word, the heap check
 902          failure sequence looks like this:
 903
 904                 Sp[-1] = R3.w;
 905                 Sp[-2] = WORD_TAG;
 906                 Sp -= 2;
 907                 JMP_(stg_chk_2)
 908
 909           after pushing R3, we have pointers in R1 and R2 which corresponds
 910           to the 2-pointer canned sequence.
 911
 912   -------------------------------------------------------------------------- */
 913
 914 /*- 0 Regs -------------------------------------------------------------------*/
 915
 916 EXTFUN(__stg_chk_0)
 917 {
 918   FB_
 919   Sp -= 1;
 920   Sp[0] = R1.w;
 921   GC_GENERIC;
 922   FE_
 923 }
 924
 925 /*- 1 Reg --------------------------------------------------------------------*/
 926
 927 EXTFUN(__stg_chk_1)
 928 {
 929   FB_
 930   Sp -= 2;
 931   Sp[1] = R1.w;
 932   Sp[0] = R2.w;
 933   GC_GENERIC;
 934   FE_
 935 }
 936
 937 /*- 1 Reg (non-ptr) ----------------------------------------------------------*/
 938
 939 EXTFUN(stg_chk_1n)
 940 {
 941   FB_
 942   Sp -= 3;
 943   Sp[2] = R1.w;
 944   Sp[1] = WORD_TAG; /* ToDo: or maybe its an int? */
 945   Sp[0] = R2.w;
 946   GC_GENERIC;
 947   FE_
 948 }
 949
 950 /*- 2 Regs--------------------------------------------------------------------*/
 951
 952 EXTFUN(stg_chk_2)
 953 {
 954   FB_
 955   Sp -= 3;
 956   Sp[2] = R2.w;
 957   Sp[1] = R1.w;
 958   Sp[0] = R3.w;
 959   GC_GENERIC;
 960   FE_
 961 }
 962
 963 /*- 3 Regs -------------------------------------------------------------------*/
 964
 965 EXTFUN(stg_chk_3)
 966 {
 967   FB_
 968   Sp -= 4;
 969   Sp[3] = R3.w;
 970   Sp[2] = R2.w;
 971   Sp[1] = R1.w;
 972   Sp[0] = R4.w;
 973   GC_GENERIC;
 974   FE_
 975 }
 976
 977 /*- 4 Regs -------------------------------------------------------------------*/
 978
 979 EXTFUN(stg_chk_4)
 980 {
 981   FB_
 982   Sp -= 5;
 983   Sp[4] = R4.w;
 984   Sp[3] = R3.w;
 985   Sp[2] = R2.w;
 986   Sp[1] = R1.w;
 987   Sp[0] = R5.w;
 988   GC_GENERIC;
 989   FE_
 990 }
 991
 992 /*- 5 Regs -------------------------------------------------------------------*/
 993
 994 EXTFUN(stg_chk_5)
 995 {
 996   FB_
 997   Sp -= 6;
 998   Sp[5] = R5.w;
 999   Sp[4] = R4.w;
1000   Sp[3] = R3.w;
1001   Sp[2] = R2.w;
1002   Sp[1] = R1.w;
1003   Sp[0] = R6.w;
1004   GC_GENERIC;
1005   FE_
1006 }
1007
1008 /*- 6 Regs -------------------------------------------------------------------*/
1009
1010 EXTFUN(stg_chk_6)
1011 {
1012   FB_
1013   Sp -= 7;
1014   Sp[6] = R6.w;
1015   Sp[5] = R5.w;
1016   Sp[4] = R4.w;
1017   Sp[3] = R3.w;
1018   Sp[2] = R2.w;
1019   Sp[1] = R1.w;
1020   Sp[0] = R7.w;
1021   GC_GENERIC;
1022   FE_
1023 }
1024
1025 /*- 7 Regs -------------------------------------------------------------------*/
1026
1027 EXTFUN(stg_chk_7)
1028 {
1029   FB_
1030   Sp -= 8;
1031   Sp[7] = R7.w;
1032   Sp[6] = R6.w;
1033   Sp[5] = R5.w;
1034   Sp[4] = R4.w;
1035   Sp[3] = R3.w;
1036   Sp[2] = R2.w;
1037   Sp[1] = R1.w;
1038   Sp[0] = R8.w;
1039   GC_GENERIC;
1040   FE_
1041 }
1042
1043 /*- 8 Regs -------------------------------------------------------------------*/
1044
1045 EXTFUN(stg_chk_8)
1046 {
1047   FB_
1048   Sp -= 9;
1049   Sp[8] = R8.w;
1050   Sp[7] = R7.w;
1051   Sp[6] = R6.w;
1052   Sp[5] = R5.w;
1053   Sp[4] = R4.w;
1054   Sp[3] = R3.w;
1055   Sp[2] = R2.w;
1056   Sp[1] = R1.w;
1057   Sp[0] = R9.w;
1058   GC_GENERIC;
1059   FE_
1060 }
1061
1062 /* -----------------------------------------------------------------------------
1063    Generic Heap Check Code.
1064
1065    Called with Liveness mask in R9,  Return address in R10.
1066    Stack must be consistent (tagged, and containing all necessary info pointers
1067    to relevant SRTs).
1068
1069    We also define an stg_gen_yield here, because it's very similar.
1070    -------------------------------------------------------------------------- */
1071
1072 #if SIZEOF_DOUBLE > SIZEOF_VOID_P
1073
1074 #define RESTORE_EVERYTHING                      \
1075     D2   = PK_DBL(Sp+16);                       \
1076     D1   = PK_DBL(Sp+14);                       \
1077     F4   = PK_FLT(Sp+13);                       \
1078     F3   = PK_FLT(Sp+12);                       \
1079     F2   = PK_FLT(Sp+11);                       \
1080     F1   = PK_FLT(Sp+10);                       \
1081     R8.w = Sp[9];                               \
1082     R7.w = Sp[8];                               \
1083     R6.w = Sp[7];                               \
1084     R5.w = Sp[6];                               \
1085     R4.w = Sp[5];                               \
1086     R3.w = Sp[4];                               \
1087     R2.w = Sp[3];                               \
1088     R1.w = Sp[2];                               \
1089     Sp += 18;
1090
1091 #define RET_OFFSET (-17)
1092
1093 #define SAVE_EVERYTHING                         \
1094     ASSIGN_DBL(Sp-2,D2);                        \
1095     ASSIGN_DBL(Sp-4,D1);                        \
1096     ASSIGN_FLT(Sp-5,F4);                        \
1097     ASSIGN_FLT(Sp-6,F3);                        \
1098     ASSIGN_FLT(Sp-7,F2);                        \
1099     ASSIGN_FLT(Sp-8,F1);                        \
1100     Sp[-9]  = R8.w;                             \
1101     Sp[-10] = R7.w;                             \
1102     Sp[-11] = R6.w;                             \
1103     Sp[-12] = R5.w;                             \
1104     Sp[-13] = R4.w;                             \
1105     Sp[-14] = R3.w;                             \
1106     Sp[-15] = R2.w;                             \
1107     Sp[-16] = R1.w;                             \
1108     Sp[-17] = R10.w;    /* return address */    \
1109     Sp[-18] = R9.w;     /* liveness mask  */    \
1110     Sp[-19] = (W_)&stg_gen_chk_info;            \
1111     Sp -= 19;
1112
1113 #else
1114
1115 #define RESTORE_EVERYTHING                      \
1116     D2   = PK_DBL(Sp+15);                       \
1117     D1   = PK_DBL(Sp+14);                       \
1118     F4   = PK_FLT(Sp+13);                       \
1119     F3   = PK_FLT(Sp+12);                       \
1120     F2   = PK_FLT(Sp+11);                       \
1121     F1   = PK_FLT(Sp+10);                       \
1122     R8.w = Sp[9];                               \
1123     R7.w = Sp[8];                               \
1124     R6.w = Sp[7];                               \
1125     R5.w = Sp[6];                               \
1126     R4.w = Sp[5];                               \
1127     R3.w = Sp[4];                               \
1128     R2.w = Sp[3];                               \
1129     R1.w = Sp[2];                               \
1130     Sp += 16;
1131
1132 #define RET_OFFSET (-15)
1133
1134 #define SAVE_EVERYTHING                         \
1135     ASSIGN_DBL(Sp-1,D2);                        \
1136     ASSIGN_DBL(Sp-2,D1);                        \
1137     ASSIGN_FLT(Sp-3,F4);                        \
1138     ASSIGN_FLT(Sp-4,F3);                        \
1139     ASSIGN_FLT(Sp-5,F2);                        \
1140     ASSIGN_FLT(Sp-6,F1);                        \
1141     Sp[-7]  = R8.w;                             \
1142     Sp[-8]  = R7.w;                             \
1143     Sp[-9]  = R6.w;                             \
1144     Sp[-10] = R5.w;                             \
1145     Sp[-11] = R4.w;                             \
1146     Sp[-12] = R3.w;                             \
1147     Sp[-13] = R2.w;                             \
1148     Sp[-14] = R1.w;                             \
1149     Sp[-15] = R10.w;    /* return address */    \
1150     Sp[-16] = R9.w;     /* liveness mask  */    \
1151     Sp[-17] = (W_)&stg_gen_chk_info;            \
1152     Sp -= 17;
1153
1154 #endif
1155
1156 INFO_TABLE_SRT_BITMAP(stg_gen_chk_info, stg_gen_chk_ret, 0,
1157                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1158                       RET_DYN,, EF_, 0, 0);
1159
1160 /* bitmap in the above info table is unused, the real one is on the stack.
1161  */
1162
1163 FN_(stg_gen_chk_ret)
1164 {
1165   FB_
1166   RESTORE_EVERYTHING;
1167   JMP_(Sp[RET_OFFSET]); /* NO ENTRY_CODE() - this is a direct ret address */
1168   FE_
1169 }
1170
1171 FN_(stg_gen_chk)
1172 {
1173   FB_
1174   SAVE_EVERYTHING;
1175   GC_GENERIC
1176   FE_
1177 }
1178
1179 /*
1180  * stg_gen_hp is used by MAYBE_GC, where we can't use GC_GENERIC
1181  * because we've just failed doYouWantToGC(), not a standard heap
1182  * check.  GC_GENERIC would end up returning StackOverflow.
1183  */
1184 FN_(stg_gen_hp)
1185 {
1186   FB_
1187   SAVE_EVERYTHING;
1188   HP_GENERIC
1189   FE_
1190 }
1191
1192 /* -----------------------------------------------------------------------------
1193    Yields
1194    -------------------------------------------------------------------------- */
1195
1196 FN_(stg_gen_yield)
1197 {
1198   FB_
1199   SAVE_EVERYTHING;
1200   YIELD_GENERIC
1201   FE_
1202 }
1203
1204 FN_(stg_yield_noregs)
1205 {
1206   FB_
1207   Sp--;
1208   Sp[0] = (W_)&stg_gc_noregs_ret_info;
1209   YIELD_GENERIC;
1210   FE_
1211 }
1212
1213 FN_(stg_yield_to_interpreter)
1214 {
1215   FB_
1216   /* No need to save everything - no live registers */
1217   YIELD_TO_INTERPRETER
1218   FE_
1219 }
1220
1221 /* -----------------------------------------------------------------------------
1222    Blocks
1223    -------------------------------------------------------------------------- */
1224
1225 FN_(stg_gen_block)
1226 {
1227   FB_
1228   SAVE_EVERYTHING;
1229   BLOCK_GENERIC
1230   FE_
1231 }
1232
1233 FN_(stg_block_noregs)
1234 {
1235   FB_
1236   Sp--;
1237   Sp[0] = (W_)&stg_gc_noregs_ret_info;
1238   BLOCK_GENERIC;
1239   FE_
1240 }
1241
1242 FN_(stg_block_1)
1243 {
1244   FB_
1245   Sp--;
1246   Sp[0] = R1.w;
1247   BLOCK_ENTER;
1248   FE_
1249 }
1250
1251 /* -----------------------------------------------------------------------------
1252  * takeMVar/putMVar-specific blocks
1253  *
1254  * Stack layout for a thread blocked in takeMVar:
1255  *
1256  *       ret. addr
1257  *       ptr to MVar   (R1)
1258  *       stg_block_takemvar_ret
1259  *
1260  * Stack layout for a thread blocked in putMVar:
1261  *
1262  *       ret. addr
1263  *       ptr to Value  (R2)
1264  *       ptr to MVar   (R1)
1265  *       stg_block_putmvar_ret
1266  *
1267  * See PrimOps.hc for a description of the workings of take/putMVar.
1268  *
1269  * -------------------------------------------------------------------------- */
1270
1271 INFO_TABLE_SRT_BITMAP(stg_block_takemvar_ret_info,  stg_block_takemvar_ret,
1272                       0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1273                       RET_SMALL,, IF_, 0, 0);
1274
1275 IF_(stg_block_takemvar_ret)
1276 {
1277   FB_
1278   R1.w = Sp[0];
1279   Sp++;
1280   JMP_(takeMVarzh_fast);
1281   FE_
1282 }
1283
1284 FN_(stg_block_takemvar)
1285 {
1286   FB_
1287   Sp -= 2;
1288   Sp[1] = R1.w;
1289   Sp[0] = (W_)&stg_block_takemvar_ret;
1290   BLOCK_GENERIC;
1291   FE_
1292 }
1293
1294 INFO_TABLE_SRT_BITMAP(stg_block_putmvar_ret_info,  stg_block_putmvar_ret,
1295                       0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1296                       RET_SMALL,, IF_, 0, 0);
1297
1298 IF_(stg_block_putmvar_ret)
1299 {
1300   FB_
1301   R2.w = Sp[1];
1302   R1.w = Sp[0];
1303   Sp += 2;
1304   JMP_(putMVarzh_fast);
1305   FE_
1306 }
1307
1308 FN_(stg_block_putmvar)
1309 {
1310   FB_
1311   Sp -= 3;
1312   Sp[2] = R2.w;
1313   Sp[1] = R1.w;
1314   Sp[0] = (W_)&stg_block_putmvar_ret;
1315   BLOCK_GENERIC;
1316   FE_
1317 }