ghc/rts/HeapStackCheck.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: HeapStackCheck.hc,v 1.29 2003/03/19 18:56:14 sof 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_LEN*/,
 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_LEN*/,
 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_LEN*/,
 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_LEN*/,
 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_LEN*/,
 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_LEN*/,
 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_LEN*/,
 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_LEN*/,
 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_LEN*/,
 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     D2   = PK_DBL(Sp+17);                       \
 814     D1   = PK_DBL(Sp+15);                       \
 815     F4   = PK_FLT(Sp+14);                       \
 816     F3   = PK_FLT(Sp+13);                       \
 817     F2   = PK_FLT(Sp+12);                       \
 818     F1   = PK_FLT(Sp+11);                       \
 819     R8.w = Sp[10];                              \
 820     R7.w = Sp[9];                               \
 821     R6.w = Sp[8];                               \
 822     R5.w = Sp[7];                               \
 823     R4.w = Sp[6];                               \
 824     R3.w = Sp[5];                               \
 825     R2.w = Sp[4];                               \
 826     R1.w = Sp[3];                               \
 827     Sp += 19;
 828
 829 #define RET_OFFSET (-17)
 830
 831 #define SAVE_EVERYTHING                         \
 832     Sp -= 19;                                   \
 833     ASSIGN_DBL(Sp+17,D2);                       \
 834     ASSIGN_DBL(Sp+15,D1);                       \
 835     ASSIGN_FLT(Sp+14,F4);                       \
 836     ASSIGN_FLT(Sp+13,F3);                       \
 837     ASSIGN_FLT(Sp+12,F2);                       \
 838     ASSIGN_FLT(Sp+11,F1);                       \
 839     Sp[10] = R8.w;                              \
 840     Sp[9] = R7.w;                               \
 841     Sp[8] = R6.w;                               \
 842     Sp[7] = R5.w;                               \
 843     Sp[6] = R4.w;                               \
 844     Sp[5] = R3.w;                               \
 845     Sp[4] = R2.w;                               \
 846     Sp[3] = R1.w;                               \
 847     Sp[2] = R10.w;    /* return address */      \
 848     Sp[1] = R9.w;     /* liveness mask  */      \
 849     Sp[0] = (W_)&stg_gc_gen_info;               \
 850
 851 INFO_TABLE_RET( stg_gc_gen_info, stg_gc_gen_ret,
 852                 0/*bitmap*/,
 853                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 854                 RET_DYN,, EF_, 0, 0);
 855
 856 /* bitmap in the above info table is unused, the real one is on the stack.
 857  */
 858
 859 FN_(stg_gc_gen_ret)
 860 {
 861   FB_
 862   RESTORE_EVERYTHING;
 863   JMP_(Sp[RET_OFFSET]); /* No ENTRY_CODE() - this is an actual code ptr */
 864   FE_
 865 }
 866
 867 FN_(stg_gc_gen)
 868 {
 869   FB_
 870   SAVE_EVERYTHING;
 871   GC_GENERIC
 872   FE_
 873 }
 874
 875 // A heap check at an unboxed tuple return point.  The return address
 876 // is on the stack, and we can find it by using the offsets given
 877 // to us in the liveness mask.
 878 FN_(stg_gc_ut)
 879 {
 880   FB_
 881   R10.w = (W_)ENTRY_CODE(Sp[GET_NONPTRS(R9.w) + GET_PTRS(R9.w)]);
 882   SAVE_EVERYTHING;
 883   GC_GENERIC
 884   FE_
 885 }
 886
 887 /*
 888  * stg_gen_hp is used by MAYBE_GC, where we can't use GC_GENERIC
 889  * because we've just failed doYouWantToGC(), not a standard heap
 890  * check.  GC_GENERIC would end up returning StackOverflow.
 891  */
 892 FN_(stg_gc_gen_hp)
 893 {
 894   FB_
 895   SAVE_EVERYTHING;
 896   HP_GENERIC
 897   FE_
 898 }
 899
 900 /* -----------------------------------------------------------------------------
 901    Yields
 902    -------------------------------------------------------------------------- */
 903
 904 FN_(stg_gen_yield)
 905 {
 906   FB_
 907   SAVE_EVERYTHING;
 908   YIELD_GENERIC
 909   FE_
 910 }
 911
 912 FN_(stg_yield_noregs)
 913 {
 914   FB_
 915   YIELD_GENERIC;
 916   FE_
 917 }
 918
 919 /* -----------------------------------------------------------------------------
 920    Yielding to the interpreter... top of stack says what to do next.
 921    -------------------------------------------------------------------------- */
 922
 923 FN_(stg_yield_to_interpreter)
 924 {
 925   FB_
 926   YIELD_TO_INTERPRETER;
 927   FE_
 928 }
 929
 930 /* -----------------------------------------------------------------------------
 931    Blocks
 932    -------------------------------------------------------------------------- */
 933
 934 FN_(stg_gen_block)
 935 {
 936   FB_
 937   SAVE_EVERYTHING;
 938   BLOCK_GENERIC
 939   FE_
 940 }
 941
 942 FN_(stg_block_noregs)
 943 {
 944   FB_
 945   BLOCK_GENERIC;
 946   FE_
 947 }
 948
 949 FN_(stg_block_1)
 950 {
 951   FB_
 952   Sp -= 2;
 953   Sp[1] = R1.w;
 954   Sp[0] = (W_)&stg_enter_info;
 955   BLOCK_GENERIC;
 956   FE_
 957 }
 958
 959 /* -----------------------------------------------------------------------------
 960  * takeMVar/putMVar-specific blocks
 961  *
 962  * Stack layout for a thread blocked in takeMVar:
 963  *
 964  *       ret. addr
 965  *       ptr to MVar   (R1)
 966  *       stg_block_takemvar_info
 967  *
 968  * Stack layout for a thread blocked in putMVar:
 969  *
 970  *       ret. addr
 971  *       ptr to Value  (R2)
 972  *       ptr to MVar   (R1)
 973  *       stg_block_putmvar_info
 974  *
 975  * See PrimOps.hc for a description of the workings of take/putMVar.
 976  *
 977  * -------------------------------------------------------------------------- */
 978
 979 INFO_TABLE_RET( stg_block_takemvar_info,  stg_block_takemvar_ret,
 980                 MK_SMALL_BITMAP(1/*framesize*/, 0/*bitmap*/),
 981                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
 982                 RET_SMALL,, IF_, 0, 0);
 983
 984 IF_(stg_block_takemvar_ret)
 985 {
 986   FB_
 987   R1.w = Sp[1];
 988   Sp += 2;
 989   JMP_(takeMVarzh_fast);
 990   FE_
 991 }
 992
 993 FN_(stg_block_takemvar)
 994 {
 995   FB_
 996   Sp -= 2;
 997   Sp[1] = R1.w;
 998   Sp[0] = (W_)&stg_block_takemvar_info;
 999   BLOCK_GENERIC;
1000   FE_
1001 }
1002
1003 INFO_TABLE_RET( stg_block_putmvar_info,  stg_block_putmvar_ret,
1004                 MK_SMALL_BITMAP(2/*framesize*/, 0/*bitmap*/),
1005                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1006                 RET_SMALL,, IF_, 0, 0);
1007
1008 IF_(stg_block_putmvar_ret)
1009 {
1010   FB_
1011   R2.w = Sp[2];
1012   R1.w = Sp[1];
1013   Sp += 3;
1014   JMP_(putMVarzh_fast);
1015   FE_
1016 }
1017
1018 FN_(stg_block_putmvar)
1019 {
1020   FB_
1021   Sp -= 3;
1022   Sp[2] = R2.w;
1023   Sp[1] = R1.w;
1024   Sp[0] = (W_)&stg_block_putmvar_info;
1025   BLOCK_GENERIC;
1026   FE_
1027 }
1028
1029 #ifdef mingw32_TARGET_OS
1030 INFO_TABLE_RET( stg_block_async_info,  stg_block_async_ret,
1031                 MK_SMALL_BITMAP(0/*framesize*/, 0/*bitmap*/),
1032                 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
1033                 RET_SMALL,, IF_, 0, 0);
1034
1035 IF_(stg_block_async_ret)
1036 {
1037   StgAsyncIOResult* ares;
1038   int len,errC;
1039   FB_
1040   ares = CurrentTSO->block_info.async_result;
1041   len  = ares->len;
1042   errC = ares->errCode;
1043   CurrentTSO->block_info.async_result = NULL;
1044   STGCALL1(free,ares);
1045   R1.w = len;
1046   *Sp = (W_)errC;
1047   JMP_(ENTRY_CODE(Sp[1]));
1048   FE_
1049 }
1050
1051 FN_(stg_block_async)
1052 {
1053   FB_
1054   Sp -= 1;
1055   Sp[0] = (W_)&stg_block_async_info;
1056   BLOCK_GENERIC;
1057   FE_
1058 }
1059
1060 #endif