ghc/rts/HeapStackCheck.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: HeapStackCheck.hc,v 1.31 2003/05/14 09:13:59 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-2002
   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 "RtsFlags.h"
  16 #include "RtsUtils.h"
  17 #include "Apply.h"
  18
  19 #include <stdio.h>
  20
  21 #ifdef mingw32_TARGET_OS
  22 #include <stdlib.h>
  23 #endif
  24
  25 /* Stack/Heap Check Failure
  26  * ------------------------
  27  *
  28  * On discovering that a stack or heap check has failed, we do the following:
  29  *
  30  *    - If the context_switch flag is set, indicating that there are more
  31  *      threads waiting to run, we yield to the scheduler
  32  *      (return ThreadYielding).
  33  *
  34  *    - If Hp > HpLim, we've had a heap check failure.  This means we've
  35  *      come to the end of the current heap block, so we try to chain
  36  *      another block on with ExtendNursery().
  37  *
  38  *           - If this succeeds, we carry on without returning to the
  39  *             scheduler.
  40  *
  41  *           - If it fails, we return to the scheduler claiming HeapOverflow
  42  *             so that a garbage collection can be performed.
  43  *
  44  *    - If Hp <= HpLim, it must have been a stack check that failed.  In
  45  *      which case, we return to the scheduler claiming StackOverflow, the
  46  *      scheduler will either increase the size of our stack, or flag
  47  *      an error if the stack is already too big.
  48  *
  49  * The effect of checking for context switch only in the heap/stack check
  50  * failure code is that we'll switch threads after the current thread has
  51  * reached the end of its heap block.  If a thread isn't allocating
  52  * at all, it won't yield.  Hopefully this won't be a problem in practice.
  53  */
  54
  55 /* Remember that the return address is *removed* when returning to a
  56  * ThreadRunGHC thread.
  57  */
  58
  59 #define GC_GENERIC                                      \
  60   DEBUG_ONLY(heapCheckFail());                          \
  61   if (Hp > HpLim) {                                     \
  62     Hp -= HpAlloc;                                      \
  63     if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
  64         if (context_switch) {                           \
  65             R1.i = ThreadYielding;                      \
  66         } else {                                        \
  67            JMP_(ENTRY_CODE(Sp[0]));                     \
  68         }                                               \
  69     } else {                                            \
  70       R1.i = HeapOverflow;                              \
  71     }                                                   \
  72   } else {                                              \
  73     R1.i = StackOverflow;                               \
  74   }                                                     \
  75   SaveThreadState();                                    \
  76   CurrentTSO->what_next = ThreadRunGHC;                 \
  77   JMP_(StgReturn);
  78
  79 #define HP_GENERIC                              \
  80   SaveThreadState();                            \
  81   CurrentTSO->what_next = ThreadRunGHC;         \
  82   R1.i = HeapOverflow;                          \
  83   JMP_(StgReturn);
  84
  85 #define YIELD_GENERIC                           \
  86   SaveThreadState();                            \
  87   CurrentTSO->what_next = ThreadRunGHC;         \
  88   R1.i = ThreadYielding;                        \
  89   JMP_(StgReturn);
  90
  91 #define YIELD_TO_INTERPRETER                    \
  92   SaveThreadState();                            \
  93   CurrentTSO->what_next = ThreadInterpret;      \
  94   R1.i = ThreadYielding;                        \
  95   JMP_(StgReturn);
  96
  97 #define BLOCK_GENERIC                           \
  98   SaveThreadState();                            \
  99   CurrentTSO->what_next = ThreadRunGHC;         \
 100   R1.i = ThreadBlocked;                         \
 101   JMP_(StgReturn);
 102
 103 /* -----------------------------------------------------------------------------
 104    Heap checks in thunks/functions.
 105
 106    In these cases, node always points to the function closure.  This gives
 107    us an easy way to return to the function: just leave R1 on the top of
 108    the stack, and have the scheduler enter it to return.
 109
 110    There are canned sequences for 'n' pointer values in registers.
 111    -------------------------------------------------------------------------- */
 112
 113 INFO_TABLE_RET( stg_enter_info, stg_enter_ret,
 114                 MK_SMALL_BITMAP(1/*framesize*/, 0/*bitmap*/),
 115                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 116                 RET_SMALL,, EF_, 0, 0);
 117 EXTFUN(stg_enter_ret)
 118 {
 119   FB_
 120   R1.w = Sp[1];
 121   Sp += 2;
 122   ENTER();
 123   FE_
 124 }
 125
 126 EXTFUN(__stg_gc_enter_1)
 127 {
 128   FB_
 129   Sp -= 2;
 130   Sp[1] = R1.w;
 131   Sp[0] = (W_)&stg_enter_info;
 132   GC_GENERIC
 133   FE_
 134 }
 135
 136 #ifdef SMP
 137 EXTFUN(stg_gc_enter_1_hponly)
 138 {
 139   FB_
 140   Sp -= 1;
 141   Sp[0] = R1.w;
 142   R1.i = HeapOverflow;
 143   SaveThreadState();
 144   CurrentTSO->what_next = ThreadRunGHC;
 145   JMP_(StgReturn);
 146   FE_
 147 }
 148 #endif
 149
 150 #if defined(GRAN)
 151 /*
 152   ToDo: merge the block and yield macros, calling something like BLOCK(N)
 153         at the end;
 154 */
 155
 156 /*
 157    Should we actually ever do a yield in such a case?? -- HWL
 158 */
 159 EXTFUN(gran_yield_0)
 160 {
 161   FB_
 162   SaveThreadState();
 163   CurrentTSO->what_next = ThreadRunGHC;
 164   R1.i = ThreadYielding;
 165   JMP_(StgReturn);
 166   FE_
 167 }
 168
 169 EXTFUN(gran_yield_1)
 170 {
 171   FB_
 172   Sp -= 1;
 173   Sp[0] = R1.w;
 174   SaveThreadState();
 175   CurrentTSO->what_next = ThreadRunGHC;
 176   R1.i = ThreadYielding;
 177   JMP_(StgReturn);
 178   FE_
 179 }
 180
 181 /*- 2 Regs--------------------------------------------------------------------*/
 182
 183 EXTFUN(gran_yield_2)
 184 {
 185   FB_
 186   Sp -= 2;
 187   Sp[1] = R2.w;
 188   Sp[0] = R1.w;
 189   SaveThreadState();
 190   CurrentTSO->what_next = ThreadRunGHC;
 191   R1.i = ThreadYielding;
 192   JMP_(StgReturn);
 193   FE_
 194 }
 195
 196 /*- 3 Regs -------------------------------------------------------------------*/
 197
 198 EXTFUN(gran_yield_3)
 199 {
 200   FB_
 201   Sp -= 3;
 202   Sp[2] = R3.w;
 203   Sp[1] = R2.w;
 204   Sp[0] = R1.w;
 205   SaveThreadState();
 206   CurrentTSO->what_next = ThreadRunGHC;
 207   R1.i = ThreadYielding;
 208   JMP_(StgReturn);
 209   FE_
 210 }
 211
 212 /*- 4 Regs -------------------------------------------------------------------*/
 213
 214 EXTFUN(gran_yield_4)
 215 {
 216   FB_
 217   Sp -= 4;
 218   Sp[3] = R4.w;
 219   Sp[2] = R3.w;
 220   Sp[1] = R2.w;
 221   Sp[0] = R1.w;
 222   SaveThreadState();
 223   CurrentTSO->what_next = ThreadRunGHC;
 224   R1.i = ThreadYielding;
 225   JMP_(StgReturn);
 226   FE_
 227 }
 228
 229 /*- 5 Regs -------------------------------------------------------------------*/
 230
 231 EXTFUN(gran_yield_5)
 232 {
 233   FB_
 234   Sp -= 5;
 235   Sp[4] = R5.w;
 236   Sp[3] = R4.w;
 237   Sp[2] = R3.w;
 238   Sp[1] = R2.w;
 239   Sp[0] = R1.w;
 240   SaveThreadState();
 241   CurrentTSO->what_next = ThreadRunGHC;
 242   R1.i = ThreadYielding;
 243   JMP_(StgReturn);
 244   FE_
 245 }
 246
 247 /*- 6 Regs -------------------------------------------------------------------*/
 248
 249 EXTFUN(gran_yield_6)
 250 {
 251   FB_
 252   Sp -= 6;
 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   SaveThreadState();
 260   CurrentTSO->what_next = ThreadRunGHC;
 261   R1.i = ThreadYielding;
 262   JMP_(StgReturn);
 263   FE_
 264 }
 265
 266 /*- 7 Regs -------------------------------------------------------------------*/
 267
 268 EXTFUN(gran_yield_7)
 269 {
 270   FB_
 271   Sp -= 7;
 272   Sp[6] = R7.w;
 273   Sp[5] = R6.w;
 274   Sp[4] = R5.w;
 275   Sp[3] = R4.w;
 276   Sp[2] = R3.w;
 277   Sp[1] = R2.w;
 278   Sp[0] = R1.w;
 279   SaveThreadState();
 280   CurrentTSO->what_next = ThreadRunGHC;
 281   R1.i = ThreadYielding;
 282   JMP_(StgReturn);
 283   FE_
 284 }
 285
 286 /*- 8 Regs -------------------------------------------------------------------*/
 287
 288 EXTFUN(gran_yield_8)
 289 {
 290   FB_
 291   Sp -= 8;
 292   Sp[7] = R8.w;
 293   Sp[6] = R7.w;
 294   Sp[5] = R6.w;
 295   Sp[4] = R5.w;
 296   Sp[3] = R4.w;
 297   Sp[2] = R3.w;
 298   Sp[1] = R2.w;
 299   Sp[0] = R1.w;
 300   SaveThreadState();
 301   CurrentTSO->what_next = ThreadRunGHC;
 302   R1.i = ThreadYielding;
 303   JMP_(StgReturn);
 304   FE_
 305 }
 306
 307 // the same routines but with a block rather than a yield
 308
 309 EXTFUN(gran_block_1)
 310 {
 311   FB_
 312   Sp -= 1;
 313   Sp[0] = R1.w;
 314   SaveThreadState();
 315   CurrentTSO->what_next = ThreadRunGHC;
 316   R1.i = ThreadBlocked;
 317   JMP_(StgReturn);
 318   FE_
 319 }
 320
 321 /*- 2 Regs--------------------------------------------------------------------*/
 322
 323 EXTFUN(gran_block_2)
 324 {
 325   FB_
 326   Sp -= 2;
 327   Sp[1] = R2.w;
 328   Sp[0] = R1.w;
 329   SaveThreadState();
 330   CurrentTSO->what_next = ThreadRunGHC;
 331   R1.i = ThreadBlocked;
 332   JMP_(StgReturn);
 333   FE_
 334 }
 335
 336 /*- 3 Regs -------------------------------------------------------------------*/
 337
 338 EXTFUN(gran_block_3)
 339 {
 340   FB_
 341   Sp -= 3;
 342   Sp[2] = R3.w;
 343   Sp[1] = R2.w;
 344   Sp[0] = R1.w;
 345   SaveThreadState();
 346   CurrentTSO->what_next = ThreadRunGHC;
 347   R1.i = ThreadBlocked;
 348   JMP_(StgReturn);
 349   FE_
 350 }
 351
 352 /*- 4 Regs -------------------------------------------------------------------*/
 353
 354 EXTFUN(gran_block_4)
 355 {
 356   FB_
 357   Sp -= 4;
 358   Sp[3] = R4.w;
 359   Sp[2] = R3.w;
 360   Sp[1] = R2.w;
 361   Sp[0] = R1.w;
 362   SaveThreadState();
 363   CurrentTSO->what_next = ThreadRunGHC;
 364   R1.i = ThreadBlocked;
 365   JMP_(StgReturn);
 366   FE_
 367 }
 368
 369 /*- 5 Regs -------------------------------------------------------------------*/
 370
 371 EXTFUN(gran_block_5)
 372 {
 373   FB_
 374   Sp -= 5;
 375   Sp[4] = R5.w;
 376   Sp[3] = R4.w;
 377   Sp[2] = R3.w;
 378   Sp[1] = R2.w;
 379   Sp[0] = R1.w;
 380   SaveThreadState();
 381   CurrentTSO->what_next = ThreadRunGHC;
 382   R1.i = ThreadBlocked;
 383   JMP_(StgReturn);
 384   FE_
 385 }
 386
 387 /*- 6 Regs -------------------------------------------------------------------*/
 388
 389 EXTFUN(gran_block_6)
 390 {
 391   FB_
 392   Sp -= 6;
 393   Sp[5] = R6.w;
 394   Sp[4] = R5.w;
 395   Sp[3] = R4.w;
 396   Sp[2] = R3.w;
 397   Sp[1] = R2.w;
 398   Sp[0] = R1.w;
 399   SaveThreadState();
 400   CurrentTSO->what_next = ThreadRunGHC;
 401   R1.i = ThreadBlocked;
 402   JMP_(StgReturn);
 403   FE_
 404 }
 405
 406 /*- 7 Regs -------------------------------------------------------------------*/
 407
 408 EXTFUN(gran_block_7)
 409 {
 410   FB_
 411   Sp -= 7;
 412   Sp[6] = R7.w;
 413   Sp[5] = R6.w;
 414   Sp[4] = R5.w;
 415   Sp[3] = R4.w;
 416   Sp[2] = R3.w;
 417   Sp[1] = R2.w;
 418   Sp[0] = R1.w;
 419   SaveThreadState();
 420   CurrentTSO->what_next = ThreadRunGHC;
 421   R1.i = ThreadBlocked;
 422   JMP_(StgReturn);
 423   FE_
 424 }
 425
 426 /*- 8 Regs -------------------------------------------------------------------*/
 427
 428 EXTFUN(gran_block_8)
 429 {
 430   FB_
 431   Sp -= 8;
 432   Sp[7] = R8.w;
 433   Sp[6] = R7.w;
 434   Sp[5] = R6.w;
 435   Sp[4] = R5.w;
 436   Sp[3] = R4.w;
 437   Sp[2] = R3.w;
 438   Sp[1] = R2.w;
 439   Sp[0] = R1.w;
 440   SaveThreadState();
 441   CurrentTSO->what_next = ThreadRunGHC;
 442   R1.i = ThreadBlocked;
 443   JMP_(StgReturn);
 444   FE_
 445 }
 446
 447 #endif
 448
 449 #if 0 && defined(PAR)
 450
 451 /*
 452   Similar to stg_block_1 (called via StgMacro BLOCK_NP) but separates the
 453   saving of the thread state from the actual jump via an StgReturn.
 454   We need this separation because we call RTS routines in blocking entry codes
 455   before jumping back into the RTS (see parallel/FetchMe.hc).
 456 */
 457
 458 EXTFUN(par_block_1_no_jump)
 459 {
 460   FB_
 461   Sp -= 1;
 462   Sp[0] = R1.w;
 463   SaveThreadState();
 464   FE_
 465 }
 466
 467 EXTFUN(par_jump)
 468 {
 469   FB_
 470   CurrentTSO->what_next = ThreadRunGHC;
 471   R1.i = ThreadBlocked;
 472   JMP_(StgReturn);
 473   FE_
 474 }
 475
 476 #endif
 477
 478 /* -----------------------------------------------------------------------------
 479    Heap checks in Primitive case alternatives
 480
 481    A primitive case alternative is entered with a value either in
 482    R1, FloatReg1 or D1 depending on the return convention.  All the
 483    cases are covered below.
 484    -------------------------------------------------------------------------- */
 485
 486 /*-- No Registers live ------------------------------------------------------ */
 487
 488 EXTFUN(stg_gc_noregs)
 489 {
 490   FB_
 491   GC_GENERIC
 492   FE_
 493 }
 494
 495 /*-- void return ------------------------------------------------------------ */
 496
 497 INFO_TABLE_RET( stg_gc_void_info, stg_gc_void_ret,
 498                 MK_SMALL_BITMAP(0/*framesize*/, 0/*bitmap*/),
 499                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 500                 RET_SMALL,, EF_, 0, 0);
 501
 502 EXTFUN(stg_gc_void_ret)
 503 {
 504   FB_
 505   Sp += 1;
 506   JMP_(ENTRY_CODE(Sp[0]));
 507   FE_
 508 }
 509
 510 /*-- R1 is boxed/unpointed -------------------------------------------------- */
 511
 512 INFO_TABLE_RET( stg_gc_unpt_r1_info, stg_gc_unpt_r1_ret,
 513                 MK_SMALL_BITMAP(1/*framesize*/, 0/*bitmap*/),
 514                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 515                 RET_SMALL,, EF_, 0, 0);
 516
 517 EXTFUN(stg_gc_unpt_r1_ret)
 518 {
 519   FB_
 520   R1.w = Sp[1];
 521   Sp += 2;
 522   JMP_(ENTRY_CODE(Sp[0]));
 523   FE_
 524 }
 525
 526 EXTFUN(stg_gc_unpt_r1)
 527 {
 528   FB_
 529   Sp -= 2;
 530   Sp[1] = R1.w;
 531   Sp[0] = (W_)&stg_gc_unpt_r1_info;
 532   GC_GENERIC
 533   FE_
 534 }
 535
 536 /*-- R1 is unboxed -------------------------------------------------- */
 537
 538 INFO_TABLE_RET( stg_gc_unbx_r1_info, stg_gc_unbx_r1_ret,
 539                 MK_SMALL_BITMAP(1/*framesize*/, 1/*bitmap*/),
 540                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 541                 RET_SMALL,, EF_, 0, 0);
 542
 543 /* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
 544
 545 EXTFUN(stg_gc_unbx_r1_ret)
 546 {
 547   FB_
 548   R1.w = Sp[1];
 549   Sp += 2;
 550   JMP_(ENTRY_CODE(Sp[0]));
 551   FE_
 552 }
 553
 554 EXTFUN(stg_gc_unbx_r1)
 555 {
 556   FB_
 557   Sp -= 2;
 558   Sp[1] = R1.w;
 559   Sp[0] = (W_)&stg_gc_unbx_r1_info;
 560   GC_GENERIC
 561   FE_
 562 }
 563
 564 /*-- F1 contains a float ------------------------------------------------- */
 565
 566 INFO_TABLE_RET( stg_gc_f1_info, stg_gc_f1_ret,
 567                 MK_SMALL_BITMAP(1/*framesize*/, 1/*bitmap*/),
 568                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 569                 RET_SMALL,, EF_, 0, 0);
 570
 571 EXTFUN(stg_gc_f1_ret)
 572 {
 573   FB_
 574   F1 = PK_FLT(Sp+1);
 575   Sp += 2;
 576   JMP_(ENTRY_CODE(Sp[0]));
 577   FE_
 578 }
 579
 580 EXTFUN(stg_gc_f1)
 581 {
 582   FB_
 583   Sp -= 2;
 584   ASSIGN_FLT(Sp+1, F1);
 585   Sp[0] = (W_)&stg_gc_f1_info;
 586   GC_GENERIC
 587   FE_
 588 }
 589
 590 /*-- D1 contains a double ------------------------------------------------- */
 591
 592 /* we support doubles of either 1 or 2 words in size */
 593
 594 #if SIZEOF_DOUBLE == SIZEOF_VOID_P
 595 #  define DBL_BITMAP 1
 596 #  define DBL_WORDS  1
 597 #else
 598 #  define DBL_BITMAP 3
 599 #  define DBL_WORDS  2
 600 #endif
 601
 602 INFO_TABLE_RET( stg_gc_d1_info, stg_gc_d1_ret,
 603                 MK_SMALL_BITMAP(DBL_WORDS/*framesize*/, DBL_BITMAP/*bitmap*/),
 604                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 605                 RET_SMALL,, EF_, 0, 0);
 606
 607 EXTFUN(stg_gc_d1_ret)
 608 {
 609   FB_
 610   D1 = PK_DBL(Sp+1);
 611   Sp += 1 + sizeofW(StgDouble);
 612   JMP_(ENTRY_CODE(Sp[0]));
 613   FE_
 614 }
 615
 616 EXTFUN(stg_gc_d1)
 617 {
 618   FB_
 619   Sp -= 1 + sizeofW(StgDouble);
 620   ASSIGN_DBL(Sp+1,D1);
 621   Sp[0] = (W_)&stg_gc_d1_info;
 622   GC_GENERIC
 623   FE_
 624 }
 625
 626
 627 /*-- L1 contains an int64 ------------------------------------------------- */
 628
 629 /* we support int64s of either 1 or 2 words in size */
 630
 631 #if SIZEOF_VOID_P == 8
 632 #  define LLI_BITMAP 1
 633 #  define LLI_WORDS  1
 634 #else
 635 #  define LLI_BITMAP 3
 636 #  define LLI_WORDS  2
 637 #endif
 638
 639 INFO_TABLE_RET( stg_gc_l1_info, stg_gc_l1_ret,
 640                 MK_SMALL_BITMAP(LLI_WORDS/*framesize*/, LLI_BITMAP/*bitmap*/),
 641                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 642                 RET_SMALL,, EF_, 0, 0);
 643
 644 EXTFUN(stg_gc_l1_ret)
 645 {
 646   FB_
 647   L1 = PK_Int64(Sp+1);
 648   Sp += 1 + sizeofW(StgWord64);
 649   JMP_(ENTRY_CODE(Sp[0]));
 650   FE_
 651 }
 652
 653 EXTFUN(stg_gc_l1)
 654 {
 655   FB_
 656   Sp -= 1 + sizeofW(StgWord64);
 657   ASSIGN_Int64(Sp+1,L1);
 658   Sp[0] = (W_)&stg_gc_l1_info;
 659   GC_GENERIC
 660   FE_
 661 }
 662
 663 /*-- Unboxed tuple return, one pointer (unregisterised build only) ---------- */
 664
 665 INFO_TABLE_RET( stg_ut_1_0_unreg_info, stg_ut_1_0_unreg_ret,
 666                 MK_SMALL_BITMAP(1/*size*/, 0/*BITMAP*/),
 667                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 668                 RET_SMALL,, EF_, 0, 0);
 669
 670 EXTFUN(stg_ut_1_0_unreg_ret)
 671 {
 672   FB_
 673   Sp++;
 674   /* one ptr is on the stack (Sp[0]) */
 675   JMP_(ENTRY_CODE(Sp[1]));
 676   FE_
 677 }
 678
 679 /* -----------------------------------------------------------------------------
 680    Generic function entry heap check code.
 681
 682    At a function entry point, the arguments are as per the calling convention,
 683    i.e. some in regs and some on the stack.  There may or may not be
 684    a pointer to the function closure in R1 - if there isn't, then the heap
 685    check failure code in the function will arrange to load it.
 686
 687    The function's argument types are described in its info table, so we
 688    can just jump to this bit of generic code to save away all the
 689    registers and return to the scheduler.
 690
 691    This code arranges the stack like this:
 692
 693          |        ....         |
 694          |        args         |
 695          +---------------------+
 696          |      f_closure      |
 697          +---------------------+
 698          |        size         |
 699          +---------------------+
 700          |   stg_gc_fun_info   |
 701          +---------------------+
 702
 703    The size is the number of words of arguments on the stack, and is cached
 704    in the frame in order to simplify stack walking: otherwise the size of
 705    this stack frame would have to be calculated by looking at f's info table.
 706
 707    -------------------------------------------------------------------------- */
 708
 709 EXTFUN(__stg_gc_fun)
 710 {
 711     StgWord size;
 712     StgFunInfoTable *info;
 713     FB_
 714
 715     info = get_fun_itbl(R1.cl);
 716
 717     // cache the size
 718     if (info->fun_type == ARG_GEN) {
 719         size = BITMAP_SIZE(info->bitmap);
 720     } else if (info->fun_type == ARG_GEN_BIG) {
 721         size = ((StgLargeBitmap *)info->bitmap)->size;
 722     } else {
 723         size = BITMAP_SIZE(stg_arg_bitmaps[info->fun_type]);
 724     }
 725
 726 #ifdef NO_ARG_REGS
 727     // we don't have to save any registers away
 728     Sp -= 3;
 729     Sp[2] = R1.w;
 730     Sp[1] = size;
 731     Sp[0] = (W_)&stg_gc_fun_info;
 732     GC_GENERIC
 733 #else
 734     if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
 735         // regs already saved by the heap check code
 736         Sp -= 3;
 737         Sp[2] = R1.w;
 738         Sp[1] = size;
 739         Sp[0] = (W_)&stg_gc_fun_info;
 740         DEBUG_ONLY(fprintf(stderr, "stg_fun_gc_gen(ARG_GEN)"););
 741         GC_GENERIC
 742     } else {
 743         JMP_(stg_stack_save_entries[info->fun_type]);
 744         // jumps to stg_gc_noregs after saving stuff
 745     }
 746 #endif // !NO_ARG_REGS
 747
 748     FE_
 749 }
 750
 751 /* -----------------------------------------------------------------------------
 752    Generic Apply (return point)
 753
 754    The dual to stg_fun_gc_gen (above): this fragment returns to the
 755    function, passing arguments in the stack and in registers
 756    appropriately.  The stack layout is given above.
 757    -------------------------------------------------------------------------- */
 758
 759 INFO_TABLE_RET( stg_gc_fun_info,stg_gc_fun_ret,
 760                 MK_SMALL_BITMAP(0/*framesize*/, 0/*bitmap*/),
 761                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 762                 RET_FUN,, EF_, 0, 0);
 763
 764 EXTFUN(stg_gc_fun_ret)
 765 {
 766   FB_
 767   R1.w = Sp[2];
 768   Sp += 3;
 769 #ifdef NO_ARG_REGS
 770   // there are no argument registers to load up, so we can just jump
 771   // straight to the function's entry point.
 772   JMP_(GET_ENTRY(R1.cl));
 773 #else
 774   {
 775       StgFunInfoTable *info;
 776
 777       info = get_fun_itbl(R1.cl);
 778       if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
 779           // regs already saved by the heap check code
 780           DEBUG_ONLY(fprintf(stderr, "stg_gc_fun_ret(ARG_GEN)\n"););
 781           JMP_(info->slow_apply);
 782       } else if (info->fun_type == ARG_BCO) {
 783           // cover this case just to be on the safe side
 784           Sp -= 2;
 785           Sp[1] = R1.cl;
 786           Sp[0] = (W_)&stg_apply_interp_info;
 787           JMP_(stg_yield_to_interpreter);
 788       } else {
 789           JMP_(stg_ap_stack_entries[info->fun_type]);
 790       }
 791   }
 792 #endif
 793   FE_
 794 }
 795
 796 /* -----------------------------------------------------------------------------
 797    Generic Heap Check Code.
 798
 799    Called with Liveness mask in R9,  Return address in R10.
 800    Stack must be consistent (containing all necessary info pointers
 801    to relevant SRTs).
 802
 803    See StgMacros.h for a description of the RET_DYN stack frame.
 804
 805    We also define an stg_gen_yield here, because it's very similar.
 806    -------------------------------------------------------------------------- */
 807
 808 // For simplicity, we assume that SIZEOF_DOUBLE == 2*SIZEOF_VOID_P
 809 // on a 64-bit machine, we'll end up wasting a couple of words, but
 810 // it's not a big deal.
 811
 812 #define RESTORE_EVERYTHING                      \
 813     L1   = PK_Word64(Sp+19);                    \
 814     D2   = PK_DBL(Sp+17);                       \
 815     D1   = PK_DBL(Sp+15);                       \
 816     F4   = PK_FLT(Sp+14);                       \
 817     F3   = PK_FLT(Sp+13);                       \
 818     F2   = PK_FLT(Sp+12);                       \
 819     F1   = PK_FLT(Sp+11);                       \
 820     R8.w = Sp[10];                              \
 821     R7.w = Sp[9];                               \
 822     R6.w = Sp[8];                               \
 823     R5.w = Sp[7];                               \
 824     R4.w = Sp[6];                               \
 825     R3.w = Sp[5];                               \
 826     R2.w = Sp[4];                               \
 827     R1.w = Sp[3];                               \
 828     Sp += 21;
 829
 830 #define RET_OFFSET (-19)
 831
 832 #define SAVE_EVERYTHING                         \
 833     Sp -= 21;                                   \
 834     ASSIGN_Word64(Sp+19,L1);                    \
 835     ASSIGN_DBL(Sp+17,D2);                       \
 836     ASSIGN_DBL(Sp+15,D1);                       \
 837     ASSIGN_FLT(Sp+14,F4);                       \
 838     ASSIGN_FLT(Sp+13,F3);                       \
 839     ASSIGN_FLT(Sp+12,F2);                       \
 840     ASSIGN_FLT(Sp+11,F1);                       \
 841     Sp[10] = R8.w;                              \
 842     Sp[9] = R7.w;                               \
 843     Sp[8] = R6.w;                               \
 844     Sp[7] = R5.w;                               \
 845     Sp[6] = R4.w;                               \
 846     Sp[5] = R3.w;                               \
 847     Sp[4] = R2.w;                               \
 848     Sp[3] = R1.w;                               \
 849     Sp[2] = R10.w;    /* return address */      \
 850     Sp[1] = R9.w;     /* liveness mask  */      \
 851     Sp[0] = (W_)&stg_gc_gen_info;               \
 852
 853 INFO_TABLE_RET( stg_gc_gen_info, stg_gc_gen_ret,
 854                 0/*bitmap*/,
 855                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 856                 RET_DYN,, EF_, 0, 0);
 857
 858 /* bitmap in the above info table is unused, the real one is on the stack.
 859  */
 860
 861 FN_(stg_gc_gen_ret)
 862 {
 863   FB_
 864   RESTORE_EVERYTHING;
 865   JMP_(Sp[RET_OFFSET]); /* No ENTRY_CODE() - this is an actual code ptr */
 866   FE_
 867 }
 868
 869 FN_(stg_gc_gen)
 870 {
 871   FB_
 872   SAVE_EVERYTHING;
 873   GC_GENERIC
 874   FE_
 875 }
 876
 877 // A heap check at an unboxed tuple return point.  The return address
 878 // is on the stack, and we can find it by using the offsets given
 879 // to us in the liveness mask.
 880 FN_(stg_gc_ut)
 881 {
 882   FB_
 883   R10.w = (W_)ENTRY_CODE(Sp[GET_NONPTRS(R9.w) + GET_PTRS(R9.w)]);
 884   SAVE_EVERYTHING;
 885   GC_GENERIC
 886   FE_
 887 }
 888
 889 /*
 890  * stg_gen_hp is used by MAYBE_GC, where we can't use GC_GENERIC
 891  * because we've just failed doYouWantToGC(), not a standard heap
 892  * check.  GC_GENERIC would end up returning StackOverflow.
 893  */
 894 FN_(stg_gc_gen_hp)
 895 {
 896   FB_
 897   SAVE_EVERYTHING;
 898   HP_GENERIC
 899   FE_
 900 }
 901
 902 /* -----------------------------------------------------------------------------
 903    Yields
 904    -------------------------------------------------------------------------- */
 905
 906 FN_(stg_gen_yield)
 907 {
 908   FB_
 909   SAVE_EVERYTHING;
 910   YIELD_GENERIC
 911   FE_
 912 }
 913
 914 FN_(stg_yield_noregs)
 915 {
 916   FB_
 917   YIELD_GENERIC;
 918   FE_
 919 }
 920
 921 /* -----------------------------------------------------------------------------
 922    Yielding to the interpreter... top of stack says what to do next.
 923    -------------------------------------------------------------------------- */
 924
 925 FN_(stg_yield_to_interpreter)
 926 {
 927   FB_
 928   YIELD_TO_INTERPRETER;
 929   FE_
 930 }
 931
 932 /* -----------------------------------------------------------------------------
 933    Blocks
 934    -------------------------------------------------------------------------- */
 935
 936 FN_(stg_gen_block)
 937 {
 938   FB_
 939   SAVE_EVERYTHING;
 940   BLOCK_GENERIC
 941   FE_
 942 }
 943
 944 FN_(stg_block_noregs)
 945 {
 946   FB_
 947   BLOCK_GENERIC;
 948   FE_
 949 }
 950
 951 FN_(stg_block_1)
 952 {
 953   FB_
 954   Sp -= 2;
 955   Sp[1] = R1.w;
 956   Sp[0] = (W_)&stg_enter_info;
 957   BLOCK_GENERIC;
 958   FE_
 959 }
 960
 961 /* -----------------------------------------------------------------------------
 962  * takeMVar/putMVar-specific blocks
 963  *
 964  * Stack layout for a thread blocked in takeMVar:
 965  *
 966  *       ret. addr
 967  *       ptr to MVar   (R1)
 968  *       stg_block_takemvar_info
 969  *
 970  * Stack layout for a thread blocked in putMVar:
 971  *
 972  *       ret. addr
 973  *       ptr to Value  (R2)
 974  *       ptr to MVar   (R1)
 975  *       stg_block_putmvar_info
 976  *
 977  * See PrimOps.hc for a description of the workings of take/putMVar.
 978  *
 979  * -------------------------------------------------------------------------- */
 980
 981 INFO_TABLE_RET( stg_block_takemvar_info,  stg_block_takemvar_ret,
 982                 MK_SMALL_BITMAP(1/*framesize*/, 0/*bitmap*/),
 983                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
 984                 RET_SMALL,, IF_, 0, 0);
 985
 986 IF_(stg_block_takemvar_ret)
 987 {
 988   FB_
 989   R1.w = Sp[1];
 990   Sp += 2;
 991   JMP_(takeMVarzh_fast);
 992   FE_
 993 }
 994
 995 FN_(stg_block_takemvar)
 996 {
 997   FB_
 998   Sp -= 2;
 999   Sp[1] = R1.w;
1000   Sp[0] = (W_)&stg_block_takemvar_info;
1001   BLOCK_GENERIC;
1002   FE_
1003 }
1004
1005 INFO_TABLE_RET( stg_block_putmvar_info,  stg_block_putmvar_ret,
1006                 MK_SMALL_BITMAP(2/*framesize*/, 0/*bitmap*/),
1007                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
1008                 RET_SMALL,, IF_, 0, 0);
1009
1010 IF_(stg_block_putmvar_ret)
1011 {
1012   FB_
1013   R2.w = Sp[2];
1014   R1.w = Sp[1];
1015   Sp += 3;
1016   JMP_(putMVarzh_fast);
1017   FE_
1018 }
1019
1020 FN_(stg_block_putmvar)
1021 {
1022   FB_
1023   Sp -= 3;
1024   Sp[2] = R2.w;
1025   Sp[1] = R1.w;
1026   Sp[0] = (W_)&stg_block_putmvar_info;
1027   BLOCK_GENERIC;
1028   FE_
1029 }
1030
1031 #ifdef mingw32_TARGET_OS
1032 INFO_TABLE_RET( stg_block_async_info,  stg_block_async_ret,
1033                 MK_SMALL_BITMAP(0/*framesize*/, 0/*bitmap*/),
1034                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
1035                 RET_SMALL,, IF_, 0, 0);
1036
1037 IF_(stg_block_async_ret)
1038 {
1039   StgAsyncIOResult* ares;
1040   int len,errC;
1041   FB_
1042   ares = CurrentTSO->block_info.async_result;
1043   len  = ares->len;
1044   errC = ares->errCode;
1045   CurrentTSO->block_info.async_result = NULL;
1046   STGCALL1(free,ares);
1047   R1.w = len;
1048   *Sp = (W_)errC;
1049   JMP_(ENTRY_CODE(Sp[1]));
1050   FE_
1051 }
1052
1053 FN_(stg_block_async)
1054 {
1055   FB_
1056   Sp -= 1;
1057   Sp[0] = (W_)&stg_block_async_info;
1058   BLOCK_GENERIC;
1059   FE_
1060 }
1061
1062 #endif