ghc/rts/HeapStackCheck.hc

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