ghc/rts/HeapStackCheck.hc

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