ghc/rts/HeapStackCheck.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: HeapStackCheck.hc,v 1.25 2002/02/28 18:54:53 sof 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 registers 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_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_info;
 659   GC_GENERIC
 660   FE_
 661 }
 662
 663 /*-- R1 is boxed/unpointed -------------------------------------------------- */
 664
 665 INFO_TABLE_SRT_BITMAP(stg_gc_unpt_r1_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 #ifdef REG_R1
 673   R1.w = Sp[0];
 674   Sp += 1;
 675   JMP_(ENTRY_CODE(Sp[0]));
 676 #else
 677   /* Keep R1 on the stack */
 678   JMP_(ENTRY_CODE(Sp[1]));
 679 #endif
 680   FE_
 681 }
 682
 683 EXTFUN(stg_gc_unpt_r1)
 684 {
 685   FB_
 686   Sp -= 2;
 687   Sp[1] = R1.w;
 688   Sp[0] = (W_)&stg_gc_unpt_r1_info;
 689   GC_GENERIC
 690   FE_
 691 }
 692
 693 /*-- R1 is unboxed -------------------------------------------------- */
 694
 695 INFO_TABLE_SRT_BITMAP(stg_gc_unbx_r1_info, stg_gc_unbx_r1_ret, 1/*BITMAP*/,
 696                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 697                       RET_SMALL,, EF_, 0, 0);
 698 /* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
 699
 700 EXTFUN(stg_gc_unbx_r1_ret)
 701 {
 702   FB_
 703   R1.w = Sp[0];
 704   Sp += 1;
 705   JMP_(ENTRY_CODE(Sp[0]));
 706   FE_
 707 }
 708
 709 EXTFUN(stg_gc_unbx_r1)
 710 {
 711   FB_
 712   Sp -= 2;
 713   Sp[1] = R1.w;
 714   Sp[0] = (W_)&stg_gc_unbx_r1_info;
 715   GC_GENERIC
 716   FE_
 717 }
 718
 719 /*-- F1 contains a float ------------------------------------------------- */
 720
 721 INFO_TABLE_SRT_BITMAP(stg_gc_f1_info, stg_gc_f1_ret, 1/*BITMAP*/,
 722                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 723                       RET_SMALL,, EF_, 0, 0);
 724
 725 EXTFUN(stg_gc_f1_ret)
 726 {
 727   FB_
 728   F1 = PK_FLT(Sp);
 729   Sp += 1;
 730   JMP_(ENTRY_CODE(Sp[0]));
 731   FE_
 732 }
 733
 734 EXTFUN(stg_gc_f1)
 735 {
 736   FB_
 737   Sp -= 2;
 738   ASSIGN_FLT(Sp+1, F1);
 739   Sp[0] = (W_)&stg_gc_f1_info;
 740   GC_GENERIC
 741   FE_
 742 }
 743
 744 /*-- D1 contains a double ------------------------------------------------- */
 745
 746 /* we support doubles of either 1 or 2 words in size */
 747
 748 #if SIZEOF_DOUBLE == SIZEOF_VOID_P
 749 #  define DBL_BITMAP 1
 750 #else
 751 #  define DBL_BITMAP 3
 752 #endif
 753
 754 INFO_TABLE_SRT_BITMAP(stg_gc_d1_info, stg_gc_d1_ret, DBL_BITMAP,
 755                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 756                       RET_SMALL,, EF_, 0, 0);
 757
 758 EXTFUN(stg_gc_d1_ret)
 759 {
 760   FB_
 761   D1 = PK_DBL(Sp);
 762   Sp += sizeofW(StgDouble);
 763   JMP_(ENTRY_CODE(Sp[0]));
 764   FE_
 765 }
 766
 767 EXTFUN(stg_gc_d1)
 768 {
 769   FB_
 770   Sp -= 1 + sizeofW(StgDouble);
 771   ASSIGN_DBL(Sp+1,D1);
 772   Sp[0] = (W_)&stg_gc_d1_info;
 773   GC_GENERIC
 774   FE_
 775 }
 776
 777
 778 /*-- L1 contains an int64 ------------------------------------------------- */
 779
 780 /* we support int64s of either 1 or 2 words in size */
 781
 782 #if SIZEOF_VOID_P == 8
 783 #  define LLI_BITMAP 1
 784 #else
 785 #  define LLI_BITMAP 3
 786 #endif
 787
 788 INFO_TABLE_SRT_BITMAP(stg_gc_l1_info, stg_gc_l1_ret, LLI_BITMAP,
 789                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 790                       RET_SMALL,, EF_, 0, 0);
 791
 792 EXTFUN(stg_gc_l1_ret)
 793 {
 794   FB_
 795   L1 = PK_Int64(Sp);
 796   Sp += sizeofW(StgWord64);
 797   JMP_(ENTRY_CODE(Sp[0]));
 798   FE_
 799 }
 800
 801 EXTFUN(stg_gc_l1)
 802 {
 803   FB_
 804   Sp -= 1 + sizeofW(StgWord64);
 805   ASSIGN_Int64(Sp+1,L1);
 806   Sp[0] = (W_)&stg_gc_l1_info;
 807   GC_GENERIC
 808   FE_
 809 }
 810
 811 /* -----------------------------------------------------------------------------
 812    Heap checks for unboxed tuple case alternatives
 813
 814    The story is:
 815
 816       - for an unboxed tuple with n components, we rearrange the components
 817         with pointers first followed by non-pointers. (NB: not done yet)
 818
 819       - The first k components are allocated registers, where k is the
 820         number of components that will fit in real registers.
 821
 822       - The rest are placed on the stack, with space left for tagging
 823         of the non-pointer block if necessary.
 824
 825       - On failure of a heap check:
 826                 - the tag is filled in if necessary,
 827                 - we load Ri with the address of the continuation,
 828                   where i is the lowest unused vanilla register.
 829                 - jump to 'stg_gc_ut_x_y' where x is the number of pointer
 830                   registers and y the number of non-pointers.
 831                 - if the required canned sequence isn't available, it will
 832                   have to be generated at compile-time by the code
 833                   generator (this will probably happen if there are
 834                   floating-point values, for instance).
 835
 836    For now, just deal with R1, hence R2 contains the sequel address.
 837    -------------------------------------------------------------------------- */
 838
 839 /*---- R1 contains a pointer: ------ */
 840
 841 INFO_TABLE_SRT_BITMAP(stg_gc_ut_1_0_info, stg_gc_ut_1_0_ret, 1/*BITMAP*/,
 842                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 843                       RET_SMALL,, EF_, 0, 0);
 844
 845 EXTFUN(stg_gc_ut_1_0_ret)
 846 {
 847   FB_
 848   R1.w = Sp[1];
 849   Sp += 2;
 850   JMP_(ENTRY_CODE(Sp[-2]));
 851   FE_
 852 }
 853
 854 EXTFUN(stg_gc_ut_1_0)
 855 {
 856   FB_
 857   Sp -= 3;
 858   Sp[2] = R1.w;
 859   Sp[1] = R2.w;
 860   Sp[0] = (W_)&stg_gc_ut_1_0_info;
 861   GC_GENERIC
 862   FE_
 863 }
 864
 865 /*---- R1 contains a non-pointer: ------ */
 866
 867 INFO_TABLE_SRT_BITMAP(stg_gc_ut_0_1_info, stg_gc_ut_0_1_ret, 3/*BITMAP*/,
 868                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 869                       RET_SMALL,, EF_, 0, 0);
 870
 871 EXTFUN(stg_gc_ut_0_1_ret)
 872 {
 873   FB_
 874   R1.w = Sp[1];
 875   Sp += 2;
 876   JMP_(ENTRY_CODE(Sp[-2]));
 877   FE_
 878 }
 879
 880 EXTFUN(stg_gc_ut_0_1)
 881 {
 882   FB_
 883   Sp -= 3;
 884   Sp[0] = (W_)&stg_gc_ut_0_1_info;
 885   Sp[1] = R2.w;
 886   Sp[2] = R1.w;
 887   GC_GENERIC
 888   FE_
 889 }
 890
 891 /* -----------------------------------------------------------------------------
 892    Standard top-level fast-entry heap checks.
 893
 894    - we want to make the stack look like it should at the slow entry
 895      point for the function.  That way we can just push the slow
 896      entry point on the stack and return using ThreadRunGHC.
 897
 898    - The compiler will generate code to fill in any tags on the stack,
 899      in case we arrived directly at the fast entry point and these tags
 900      aren't present.
 901
 902    - The rest is hopefully handled by jumping to a canned sequence.
 903      We currently have canned sequences for 0-8 pointer registers.  If
 904      any registers contain non-pointers, we must reduce to an all-pointers
 905      situation by pushing as many registers on the stack as necessary.
 906
 907      eg. if R1, R2 contain pointers and R3 contains a word, the heap check
 908          failure sequence looks like this:
 909
 910                 Sp[-1] = R3.w;
 911                 Sp[-2] = WORD_TAG;
 912                 Sp -= 2;
 913                 JMP_(stg_chk_2)
 914
 915           after pushing R3, we have pointers in R1 and R2 which corresponds
 916           to the 2-pointer canned sequence.
 917
 918   -------------------------------------------------------------------------- */
 919
 920 /*- 0 Regs -------------------------------------------------------------------*/
 921
 922 EXTFUN(__stg_chk_0)
 923 {
 924   FB_
 925   Sp -= 1;
 926   Sp[0] = R1.w;
 927   GC_GENERIC;
 928   FE_
 929 }
 930
 931 /*- 1 Reg --------------------------------------------------------------------*/
 932
 933 EXTFUN(__stg_chk_1)
 934 {
 935   FB_
 936   Sp -= 2;
 937   Sp[1] = R1.w;
 938   Sp[0] = R2.w;
 939   GC_GENERIC;
 940   FE_
 941 }
 942
 943 /*- 1 Reg (non-ptr) ----------------------------------------------------------*/
 944
 945 EXTFUN(stg_chk_1n)
 946 {
 947   FB_
 948   Sp -= 3;
 949   Sp[2] = R1.w;
 950   Sp[1] = WORD_TAG; /* ToDo: or maybe its an int? */
 951   Sp[0] = R2.w;
 952   GC_GENERIC;
 953   FE_
 954 }
 955
 956 /*- 2 Regs--------------------------------------------------------------------*/
 957
 958 EXTFUN(stg_chk_2)
 959 {
 960   FB_
 961   Sp -= 3;
 962   Sp[2] = R2.w;
 963   Sp[1] = R1.w;
 964   Sp[0] = R3.w;
 965   GC_GENERIC;
 966   FE_
 967 }
 968
 969 /*- 3 Regs -------------------------------------------------------------------*/
 970
 971 EXTFUN(stg_chk_3)
 972 {
 973   FB_
 974   Sp -= 4;
 975   Sp[3] = R3.w;
 976   Sp[2] = R2.w;
 977   Sp[1] = R1.w;
 978   Sp[0] = R4.w;
 979   GC_GENERIC;
 980   FE_
 981 }
 982
 983 /*- 4 Regs -------------------------------------------------------------------*/
 984
 985 EXTFUN(stg_chk_4)
 986 {
 987   FB_
 988   Sp -= 5;
 989   Sp[4] = R4.w;
 990   Sp[3] = R3.w;
 991   Sp[2] = R2.w;
 992   Sp[1] = R1.w;
 993   Sp[0] = R5.w;
 994   GC_GENERIC;
 995   FE_
 996 }
 997
 998 /*- 5 Regs -------------------------------------------------------------------*/
 999
1000 EXTFUN(stg_chk_5)
1001 {
1002   FB_
1003   Sp -= 6;
1004   Sp[5] = R5.w;
1005   Sp[4] = R4.w;
1006   Sp[3] = R3.w;
1007   Sp[2] = R2.w;
1008   Sp[1] = R1.w;
1009   Sp[0] = R6.w;
1010   GC_GENERIC;
1011   FE_
1012 }
1013
1014 /*- 6 Regs -------------------------------------------------------------------*/
1015
1016 EXTFUN(stg_chk_6)
1017 {
1018   FB_
1019   Sp -= 7;
1020   Sp[6] = R6.w;
1021   Sp[5] = R5.w;
1022   Sp[4] = R4.w;
1023   Sp[3] = R3.w;
1024   Sp[2] = R2.w;
1025   Sp[1] = R1.w;
1026   Sp[0] = R7.w;
1027   GC_GENERIC;
1028   FE_
1029 }
1030
1031 /*- 7 Regs -------------------------------------------------------------------*/
1032
1033 EXTFUN(stg_chk_7)
1034 {
1035   FB_
1036   Sp -= 8;
1037   Sp[7] = R7.w;
1038   Sp[6] = R6.w;
1039   Sp[5] = R5.w;
1040   Sp[4] = R4.w;
1041   Sp[3] = R3.w;
1042   Sp[2] = R2.w;
1043   Sp[1] = R1.w;
1044   Sp[0] = R8.w;
1045   GC_GENERIC;
1046   FE_
1047 }
1048
1049 /*- 8 Regs -------------------------------------------------------------------*/
1050
1051 EXTFUN(stg_chk_8)
1052 {
1053   FB_
1054   Sp -= 9;
1055   Sp[8] = R8.w;
1056   Sp[7] = R7.w;
1057   Sp[6] = R6.w;
1058   Sp[5] = R5.w;
1059   Sp[4] = R4.w;
1060   Sp[3] = R3.w;
1061   Sp[2] = R2.w;
1062   Sp[1] = R1.w;
1063   Sp[0] = R9.w;
1064   GC_GENERIC;
1065   FE_
1066 }
1067
1068 /* -----------------------------------------------------------------------------
1069    Generic Heap Check Code.
1070
1071    Called with Liveness mask in R9,  Return address in R10.
1072    Stack must be consistent (tagged, and containing all necessary info pointers
1073    to relevant SRTs).
1074
1075    We also define an stg_gen_yield here, because it's very similar.
1076    -------------------------------------------------------------------------- */
1077
1078 #if SIZEOF_DOUBLE > SIZEOF_VOID_P
1079
1080 #define RESTORE_EVERYTHING                      \
1081     D2   = PK_DBL(Sp+16);                       \
1082     D1   = PK_DBL(Sp+14);                       \
1083     F4   = PK_FLT(Sp+13);                       \
1084     F3   = PK_FLT(Sp+12);                       \
1085     F2   = PK_FLT(Sp+11);                       \
1086     F1   = PK_FLT(Sp+10);                       \
1087     R8.w = Sp[9];                               \
1088     R7.w = Sp[8];                               \
1089     R6.w = Sp[7];                               \
1090     R5.w = Sp[6];                               \
1091     R4.w = Sp[5];                               \
1092     R3.w = Sp[4];                               \
1093     R2.w = Sp[3];                               \
1094     R1.w = Sp[2];                               \
1095     Sp += 18;
1096
1097 #define RET_OFFSET (-17)
1098
1099 #define SAVE_EVERYTHING                         \
1100     ASSIGN_DBL(Sp-2,D2);                        \
1101     ASSIGN_DBL(Sp-4,D1);                        \
1102     ASSIGN_FLT(Sp-5,F4);                        \
1103     ASSIGN_FLT(Sp-6,F3);                        \
1104     ASSIGN_FLT(Sp-7,F2);                        \
1105     ASSIGN_FLT(Sp-8,F1);                        \
1106     Sp[-9]  = R8.w;                             \
1107     Sp[-10] = R7.w;                             \
1108     Sp[-11] = R6.w;                             \
1109     Sp[-12] = R5.w;                             \
1110     Sp[-13] = R4.w;                             \
1111     Sp[-14] = R3.w;                             \
1112     Sp[-15] = R2.w;                             \
1113     Sp[-16] = R1.w;                             \
1114     Sp[-17] = R10.w;    /* return address */    \
1115     Sp[-18] = R9.w;     /* liveness mask  */    \
1116     Sp[-19] = (W_)&stg_gen_chk_info;            \
1117     Sp -= 19;
1118
1119 #else
1120
1121 #define RESTORE_EVERYTHING                      \
1122     D2   = PK_DBL(Sp+15);                       \
1123     D1   = PK_DBL(Sp+14);                       \
1124     F4   = PK_FLT(Sp+13);                       \
1125     F3   = PK_FLT(Sp+12);                       \
1126     F2   = PK_FLT(Sp+11);                       \
1127     F1   = PK_FLT(Sp+10);                       \
1128     R8.w = Sp[9];                               \
1129     R7.w = Sp[8];                               \
1130     R6.w = Sp[7];                               \
1131     R5.w = Sp[6];                               \
1132     R4.w = Sp[5];                               \
1133     R3.w = Sp[4];                               \
1134     R2.w = Sp[3];                               \
1135     R1.w = Sp[2];                               \
1136     Sp += 16;
1137
1138 #define RET_OFFSET (-15)
1139
1140 #define SAVE_EVERYTHING                         \
1141     ASSIGN_DBL(Sp-1,D2);                        \
1142     ASSIGN_DBL(Sp-2,D1);                        \
1143     ASSIGN_FLT(Sp-3,F4);                        \
1144     ASSIGN_FLT(Sp-4,F3);                        \
1145     ASSIGN_FLT(Sp-5,F2);                        \
1146     ASSIGN_FLT(Sp-6,F1);                        \
1147     Sp[-7]  = R8.w;                             \
1148     Sp[-8]  = R7.w;                             \
1149     Sp[-9]  = R6.w;                             \
1150     Sp[-10] = R5.w;                             \
1151     Sp[-11] = R4.w;                             \
1152     Sp[-12] = R3.w;                             \
1153     Sp[-13] = R2.w;                             \
1154     Sp[-14] = R1.w;                             \
1155     Sp[-15] = R10.w;    /* return address */    \
1156     Sp[-16] = R9.w;     /* liveness mask  */    \
1157     Sp[-17] = (W_)&stg_gen_chk_info;            \
1158     Sp -= 17;
1159
1160 #endif
1161
1162 INFO_TABLE_SRT_BITMAP(stg_gen_chk_info, stg_gen_chk_ret, 0,
1163                       0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1164                       RET_DYN,, EF_, 0, 0);
1165
1166 /* bitmap in the above info table is unused, the real one is on the stack.
1167  */
1168
1169 FN_(stg_gen_chk_ret)
1170 {
1171   FB_
1172   RESTORE_EVERYTHING;
1173   JMP_(Sp[RET_OFFSET]); /* NO ENTRY_CODE() - this is a direct ret address */
1174   FE_
1175 }
1176
1177 FN_(stg_gen_chk)
1178 {
1179   FB_
1180   SAVE_EVERYTHING;
1181   GC_GENERIC
1182   FE_
1183 }
1184
1185 /*
1186  * stg_gen_hp is used by MAYBE_GC, where we can't use GC_GENERIC
1187  * because we've just failed doYouWantToGC(), not a standard heap
1188  * check.  GC_GENERIC would end up returning StackOverflow.
1189  */
1190 FN_(stg_gen_hp)
1191 {
1192   FB_
1193   SAVE_EVERYTHING;
1194   HP_GENERIC
1195   FE_
1196 }
1197
1198 /* -----------------------------------------------------------------------------
1199    Yields
1200    -------------------------------------------------------------------------- */
1201
1202 FN_(stg_gen_yield)
1203 {
1204   FB_
1205   SAVE_EVERYTHING;
1206   YIELD_GENERIC
1207   FE_
1208 }
1209
1210 FN_(stg_yield_noregs)
1211 {
1212   FB_
1213   Sp--;
1214   Sp[0] = (W_)&stg_gc_noregs_info;
1215   YIELD_GENERIC;
1216   FE_
1217 }
1218
1219 FN_(stg_yield_to_interpreter)
1220 {
1221   FB_
1222   /* No need to save everything - no live registers */
1223   YIELD_TO_INTERPRETER
1224   FE_
1225 }
1226
1227 /* -----------------------------------------------------------------------------
1228    Blocks
1229    -------------------------------------------------------------------------- */
1230
1231 FN_(stg_gen_block)
1232 {
1233   FB_
1234   SAVE_EVERYTHING;
1235   BLOCK_GENERIC
1236   FE_
1237 }
1238
1239 FN_(stg_block_noregs)
1240 {
1241   FB_
1242   Sp--;
1243   Sp[0] = (W_)&stg_gc_noregs_info;
1244   BLOCK_GENERIC;
1245   FE_
1246 }
1247
1248 FN_(stg_block_1)
1249 {
1250   FB_
1251   Sp--;
1252   Sp[0] = R1.w;
1253   BLOCK_ENTER;
1254   FE_
1255 }
1256
1257 /* -----------------------------------------------------------------------------
1258  * takeMVar/putMVar-specific blocks
1259  *
1260  * Stack layout for a thread blocked in takeMVar:
1261  *
1262  *       ret. addr
1263  *       ptr to MVar   (R1)
1264  *       stg_block_takemvar_info
1265  *
1266  * Stack layout for a thread blocked in putMVar:
1267  *
1268  *       ret. addr
1269  *       ptr to Value  (R2)
1270  *       ptr to MVar   (R1)
1271  *       stg_block_putmvar_info
1272  *
1273  * See PrimOps.hc for a description of the workings of take/putMVar.
1274  *
1275  * -------------------------------------------------------------------------- */
1276
1277 INFO_TABLE_SRT_BITMAP(stg_block_takemvar_info,  stg_block_takemvar_ret,
1278                       0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1279                       RET_SMALL,, IF_, 0, 0);
1280
1281 IF_(stg_block_takemvar_ret)
1282 {
1283   FB_
1284   R1.w = Sp[0];
1285   Sp++;
1286   JMP_(takeMVarzh_fast);
1287   FE_
1288 }
1289
1290 FN_(stg_block_takemvar)
1291 {
1292   FB_
1293   Sp -= 2;
1294   Sp[1] = R1.w;
1295   Sp[0] = (W_)&stg_block_takemvar_info;
1296   BLOCK_GENERIC;
1297   FE_
1298 }
1299
1300 INFO_TABLE_SRT_BITMAP(stg_block_putmvar_info,  stg_block_putmvar_ret,
1301                       0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1302                       RET_SMALL,, IF_, 0, 0);
1303
1304 IF_(stg_block_putmvar_ret)
1305 {
1306   FB_
1307   R2.w = Sp[1];
1308   R1.w = Sp[0];
1309   Sp += 2;
1310   JMP_(putMVarzh_fast);
1311   FE_
1312 }
1313
1314 FN_(stg_block_putmvar)
1315 {
1316   FB_
1317   Sp -= 3;
1318   Sp[2] = R2.w;
1319   Sp[1] = R1.w;
1320   Sp[0] = (W_)&stg_block_putmvar_info;
1321   BLOCK_GENERIC;
1322   FE_
1323 }