ghc/rts/HeapStackCheck.hc

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