ghc/rts/HeapStackCheck.hc

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