ghc/rts/HeapStackCheck.hc

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