HeapStackCheck.cmm 18.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
/* -----------------------------------------------------------------------------
 *
 * (c) The GHC Team, 1998-2004
 *
 * Canned Heap-Check and Stack-Check sequences.
 *
 * This file is written in a subset of C--, extended with various
 * features specific to GHC.  It is compiled by GHC directly.  For the
 * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
 *
 * ---------------------------------------------------------------------------*/

#include "Cmm.h"
14
#include "Updates.h"
15

16
#ifdef __PIC__
17
import pthread_mutex_unlock;
18
#endif
19 20
import EnterCriticalSection;
import LeaveCriticalSection;
21

22 23 24
/* Stack/Heap Check Failure
 * ------------------------
 *
Simon Marlow's avatar
Simon Marlow committed
25 26 27
 * Both heap and stack check failures end up in the same place, so
 * that we can share the code for the failure case when a proc needs
 * both a stack check and a heap check (a common case).
28
 *
Simon Marlow's avatar
Simon Marlow committed
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
 * So when we get here, we have to tell the difference between a stack
 * check failure and a heap check failure.  The code for the checks
 * looks like this:

        if (Sp - 16 < SpLim) goto c1Tf;
        Hp = Hp + 16;
        if (Hp > HpLim) goto c1Th;
        ...
    c1Th:
        HpAlloc = 16;
        goto c1Tf;
    c1Tf: jump stg_gc_enter_1 ();

 * Note that Sp is not decremented by the check, whereas Hp is.  The
 * reasons for this seem to be largely historic, I can't think of a
 * good reason not to decrement Sp at the check too. (--SDM)
45
 *
Simon Marlow's avatar
Simon Marlow committed
46 47 48
 * Note that HpLim may be set to zero arbitrarily by the timer signal
 * or another processor to trigger a context switch via heap check
 * failure.
49
 *
Simon Marlow's avatar
Simon Marlow committed
50 51 52 53 54 55 56 57
 * The job of these fragments (stg_gc_enter_1 and friends) is to
 *   1. Leave no slop in the heap, so Hp must be retreated if it was
 *      incremented by the check.  No-slop is a requirement for LDV
 *      profiling, at least.
 *   2. If a heap check failed, try to grab another heap block from
 *      the nursery and continue.
 *   3. otherwise, return to the scheduler with StackOverflow,
 *      HeapOverflow, or ThreadYielding as appropriate.
58
 *
Simon Marlow's avatar
Simon Marlow committed
59 60 61 62 63
 * We can tell whether Hp was incremented, because HpAlloc is
 * non-zero: HpAlloc is required to be zero at all times unless a
 * heap-check just failed, which is why the stack-check failure case
 * does not set HpAlloc (see code fragment above).  So that covers (1).
 * HpAlloc is zeroed in LOAD_THREAD_STATE().
64
 *
Simon Marlow's avatar
Simon Marlow committed
65 66 67 68 69
 * If Hp > HpLim, then either (a) we have reached the end of the
 * current heap block, or (b) HpLim == 0 and we should yield.  Hence
 * check Hp > HpLim first, and then HpLim == 0 to decide whether to
 * return ThreadYielding or try to grab another heap block from the
 * nursery.
70
 *
Simon Marlow's avatar
Simon Marlow committed
71 72 73
 * If Hp <= HpLim, then this must be a StackOverflow.  The scheduler
 * will either increase the size of our stack, or raise an exception if
 * the stack is already too big.
74 75
 */
 
76 77 78 79 80
#define PRE_RETURN(why,what_next)			\
  StgTSO_what_next(CurrentTSO) = what_next::I16;	\
  StgRegTable_rRet(BaseReg) = why;           	        \
  R1 = BaseReg;

81 82 83 84
/* Remember that the return address is *removed* when returning to a
 * ThreadRunGHC thread.
 */

85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
stg_gc_noregs
{
    W_ ret;

    DEBUG_ONLY(foreign "C" heapCheckFail());
    if (Hp > HpLim) {
        Hp = Hp - HpAlloc/*in bytes*/;
        if (HpLim == 0) {
                ret = ThreadYielding;
                goto sched;
        }
        if (HpAlloc <= BLOCK_SIZE
            && bdescr_link(CurrentNursery) != NULL) {
            HpAlloc = 0;
            CLOSE_NURSERY();
            CurrentNursery = bdescr_link(CurrentNursery);
            OPEN_NURSERY();
            if (Capability_context_switch(MyCapability()) != 0 :: CInt ||
                Capability_interrupt(MyCapability())      != 0 :: CInt) {
                ret = ThreadYielding;
                goto sched;
            } else {
                jump %ENTRY_CODE(Sp(0)) [];
            }
        } else {
            ret = HeapOverflow;
            goto sched;
        }
    } else {
        if (CHECK_GC()) {
            ret = HeapOverflow;
        } else {
            ret = StackOverflow;
        }
    }
  sched:
    PRE_RETURN(ret,ThreadRunGHC);
    jump stg_returnToSched [R1];
}
124

125
#define HP_GENERIC				\
126 127
    PRE_RETURN(HeapOverflow, ThreadRunGHC)      \
    jump stg_returnToSched [R1];
128

129
#define BLOCK_GENERIC				\
130 131
    PRE_RETURN(ThreadBlocked,  ThreadRunGHC)    \
    jump stg_returnToSched [R1];
132 133

#define YIELD_GENERIC				\
134 135
    PRE_RETURN(ThreadYielding, ThreadRunGHC)    \
    jump stg_returnToSched [R1];
136 137

#define BLOCK_BUT_FIRST(c)			\
138 139 140
    PRE_RETURN(ThreadBlocked, ThreadRunGHC)     \
    R2 = c;                                     \
    jump stg_returnToSchedButFirst [R1,R2,R3];
141

142
#define YIELD_TO_INTERPRETER			\
143 144
    PRE_RETURN(ThreadYielding, ThreadInterpret) \
    jump stg_returnToSchedNotPaused [R1];
145 146 147 148 149 150 151 152 153 154 155

/* -----------------------------------------------------------------------------
   Heap checks in thunks/functions.

   In these cases, node always points to the function closure.  This gives
   us an easy way to return to the function: just leave R1 on the top of
   the stack, and have the scheduler enter it to return.

   There are canned sequences for 'n' pointer values in registers.
   -------------------------------------------------------------------------- */

156 157
INFO_TABLE_RET ( stg_enter, RET_SMALL, W_ info_ptr, P_ closure )
    return (/* no return values */)
158
{
159
    ENTER(closure);
160 161
}

162
__stg_gc_enter_1 (P_ node)
163
{
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
    jump stg_gc_noregs (stg_enter_info, node) ();
}

/* -----------------------------------------------------------------------------
   Canned heap checks for primitives.

   We can't use stg_gc_fun because primitives are not functions, so
   these fragments let us save some boilerplate heap-check-failure
   code in a few common cases.
   -------------------------------------------------------------------------- */

stg_gc_prim ()
{
    W_ fun;
    fun = R9;
    call stg_gc_noregs ();
    jump fun();
}

stg_gc_prim_p (P_ arg)
{
    W_ fun;
    fun = R9;
    call stg_gc_noregs ();
    jump fun(arg);
}

stg_gc_prim_pp (P_ arg1, P_ arg2)
{
    W_ fun;
    fun = R9;
    call stg_gc_noregs ();
    jump fun(arg1,arg2);
}

stg_gc_prim_n (W_ arg)
{
    W_ fun;
    fun = R9;
    call stg_gc_noregs ();
    jump fun(arg);
205 206
}

207 208 209 210 211 212 213 214 215
/* -----------------------------------------------------------------------------
   stg_enter_checkbh is just like stg_enter, except that we also call
   checkBlockingQueues().  The point of this is that the GC can
   replace an stg_marked_upd_frame with an stg_enter_checkbh if it
   finds that the BLACKHOLE has already been updated by another
   thread.  It would be unsafe to use stg_enter, because there might
   be an orphaned BLOCKING_QUEUE now.
   -------------------------------------------------------------------------- */

216 217
/* The stg_enter_checkbh frame has the same shape as an update frame: */

218
INFO_TABLE_RET ( stg_enter_checkbh, RET_SMALL,
Simon Marlow's avatar
Simon Marlow committed
219
                 UPDATE_FRAME_FIELDS(W_,P_,info_ptr,ccs,p2,updatee))
220
    return (P_ ret)
221 222
{
    foreign "C" checkBlockingQueues(MyCapability() "ptr",
223
                                    CurrentTSO);
Simon Marlow's avatar
Simon Marlow committed
224 225 226 227 228

    // we need to return updatee now.  Note that it might be a pointer
    // to an indirection or a tagged value, we don't know which, so we
    // need to ENTER() rather than return().
    ENTER(updatee);
229 230
}

231
/* -----------------------------------------------------------------------------
232 233 234
   Info tables for returning values of various types.  These are used
   when we want to push a frame on the stack that will return a value
   to the frame underneath it.
235 236
   -------------------------------------------------------------------------- */

237 238
INFO_TABLE_RET ( stg_ret_v, RET_SMALL, W_ info_ptr )
    return (/* no return values */)
239
{
240
    return ();
241 242
}

243 244
INFO_TABLE_RET ( stg_ret_p, RET_SMALL, W_ info_ptr, P_ ptr )
    return (/* no return values */)
245
{
246
    return (ptr);
247 248
}

249 250
INFO_TABLE_RET ( stg_ret_n, RET_SMALL, W_ info_ptr, W_ nptr )
    return (/* no return values */)
251
{
252
    return (nptr);
253 254
}

255 256
INFO_TABLE_RET ( stg_ret_f, RET_SMALL, W_ info_ptr, F_ f )
    return (/* no return values */)
257
{
258
    return (f);
259 260
}

261 262
INFO_TABLE_RET ( stg_ret_d, RET_SMALL, W_ info_ptr, D_ d )
    return (/* no return values */)
263
{
264
    return (d);
265 266
}

267 268
INFO_TABLE_RET ( stg_ret_l, RET_SMALL, W_ info_ptr, L_ l )
    return (/* no return values */)
269
{
270
    return (l);
271 272
}

273 274 275 276 277 278
/* -----------------------------------------------------------------------------
   Canned heap-check failures for case alts, where we have some values
   in registers or on the stack according to the NativeReturn
   convention.
   -------------------------------------------------------------------------- */

279

280 281 282 283 284
/*-- void return ------------------------------------------------------------ */

/*-- R1 is a GC pointer, but we don't enter it ----------------------- */

stg_gc_unpt_r1 return (P_ ptr) /* NB. return convention */
285
{
286
    jump stg_gc_noregs (stg_ret_p_info, ptr) ();
287 288
}

289 290 291
/*-- R1 is unboxed -------------------------------------------------- */

stg_gc_unbx_r1 return (W_ nptr) /* NB. return convention */
292
{
293
    jump stg_gc_noregs (stg_ret_n_info, nptr) ();
294 295
}

296
/*-- F1 contains a float ------------------------------------------------- */
297

298
stg_gc_f1 return (F_ f)
299
{
300
    jump stg_gc_noregs (stg_ret_f_info, f) ();
301 302
}

303 304 305
/*-- D1 contains a double ------------------------------------------------- */

stg_gc_d1 return (D_ d)
306
{
307
    jump stg_gc_noregs (stg_ret_d_info, d) ();
308 309 310 311 312
}


/*-- L1 contains an int64 ------------------------------------------------- */

313
stg_gc_l1 return (L_ l)
314
{
315
    jump stg_gc_noregs (stg_ret_l_info, l) ();
316 317
}

318 319 320
/*-- Unboxed tuples with multiple pointers -------------------------------- */

stg_gc_pp return (P_ arg1, P_ arg2)
321
{
322 323
    call stg_gc_noregs();
    return (arg1,arg2);
324 325
}

326 327 328 329 330
stg_gc_ppp return (P_ arg1, P_ arg2, P_ arg3)
{
    call stg_gc_noregs();
    return (arg1,arg2,arg3);
}
331

332
stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4)
333
{
334 335
    call stg_gc_noregs();
    return (arg1,arg2,arg3,arg4);
336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367
}

/* -----------------------------------------------------------------------------
   Generic function entry heap check code.

   At a function entry point, the arguments are as per the calling convention,
   i.e. some in regs and some on the stack.  There may or may not be 
   a pointer to the function closure in R1 - if there isn't, then the heap
   check failure code in the function will arrange to load it.

   The function's argument types are described in its info table, so we
   can just jump to this bit of generic code to save away all the
   registers and return to the scheduler.

   This code arranges the stack like this:
	 
         |        ....         |
         |        args         |
	 +---------------------+
         |      f_closure      |
	 +---------------------+
         |        size         |
	 +---------------------+
         |   stg_gc_fun_info   |
	 +---------------------+

   The size is the number of words of arguments on the stack, and is cached
   in the frame in order to simplify stack walking: otherwise the size of
   this stack frame would have to be calculated by looking at f's info table.

   -------------------------------------------------------------------------- */

368
__stg_gc_fun /* explicit stack */
369 370 371 372 373
{
    W_ size;
    W_ info;
    W_ type;

Simon Marlow's avatar
Simon Marlow committed
374
    info = %GET_FUN_INFO(UNTAG(R1));
375 376 377 378 379 380 381

    // cache the size
    type = TO_W_(StgFunInfoExtra_fun_type(info));
    if (type == ARG_GEN) {
	size = BITMAP_SIZE(StgFunInfoExtra_bitmap(info));
    } else { 
	if (type == ARG_GEN_BIG) {
382 383 384
#ifdef TABLES_NEXT_TO_CODE
            // bitmap field holds an offset
            size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info)
Simon Marlow's avatar
Simon Marlow committed
385
                                        + %GET_ENTRY(UNTAG(R1)) /* ### */ );
386
#else
387
	    size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) );
388
#endif
389 390 391 392 393 394 395 396
	} else {
	    size = BITMAP_SIZE(W_[stg_arg_bitmaps + WDS(type)]);
	}
    }
    
#ifdef NO_ARG_REGS
    // we don't have to save any registers away
    Sp_adj(-3);
397 398
    Sp(2) = R1;
    Sp(1) = size;
399
    Sp(0) = stg_gc_fun_info;
400
    jump stg_gc_noregs [];
401 402 403 404 405 406 407
#else
    W_ type;
    type = TO_W_(StgFunInfoExtra_fun_type(info));
    // cache the size
    if (type == ARG_GEN || type == ARG_GEN_BIG) {
        // regs already saved by the heap check code
        Sp_adj(-3);
408 409
        Sp(2) = R1;
        Sp(1) = size;
410
        Sp(0) = stg_gc_fun_info;
411
        // DEBUG_ONLY(foreign "C" debugBelch("stg_fun_gc_gen(ARG_GEN)"););
412
        jump stg_gc_noregs [];
413
    } else { 
414
        jump W_[stg_stack_save_entries + WDS(type)] [*]; // all regs live
415 416
	    // jumps to stg_gc_noregs after saving stuff
    }
417
#endif /* !NO_ARG_REGS */
418 419
}

420

421 422 423 424 425 426 427 428
/* -----------------------------------------------------------------------------
   Generic Apply (return point)

   The dual to stg_fun_gc_gen (above): this fragment returns to the
   function, passing arguments in the stack and in registers
   appropriately.  The stack layout is given above.
   -------------------------------------------------------------------------- */

429 430
INFO_TABLE_RET ( stg_gc_fun, RET_FUN )
    /* explicit stack */
431
{
432
    R1 = Sp(2);
433 434 435 436
    Sp_adj(3);
#ifdef NO_ARG_REGS
    // Minor optimisation: there are no argument registers to load up,
    // so we can just jump straight to the function's entry point.
437
    jump %GET_ENTRY(UNTAG(R1)) [R1];
438 439 440 441
#else
    W_ info;
    W_ type;
    
Simon Marlow's avatar
Simon Marlow committed
442
    info = %GET_FUN_INFO(UNTAG(R1));
443 444
    type = TO_W_(StgFunInfoExtra_fun_type(info));
    if (type == ARG_GEN || type == ARG_GEN_BIG) {
445
        jump StgFunInfoExtra_slow_apply(info) [R1];
446 447 448 449 450 451
    } else { 
	if (type == ARG_BCO) {
	    // cover this case just to be on the safe side
	    Sp_adj(-2);
	    Sp(1) = R1;
	    Sp(0) = stg_apply_interp_info;
452
            jump stg_yield_to_interpreter [];
453
	} else {
454
            jump W_[stg_ap_stack_entries + WDS(type)] [R1];
455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
	}
    }
#endif
}

/* -----------------------------------------------------------------------------
   Yields
   -------------------------------------------------------------------------- */

stg_yield_noregs
{
    YIELD_GENERIC;
}

/* -----------------------------------------------------------------------------
   Yielding to the interpreter... top of stack says what to do next.
   -------------------------------------------------------------------------- */

stg_yield_to_interpreter
{
    YIELD_TO_INTERPRETER;
}

/* -----------------------------------------------------------------------------
   Blocks
   -------------------------------------------------------------------------- */

stg_block_noregs
{
    BLOCK_GENERIC;
}

/* -----------------------------------------------------------------------------
 * takeMVar/putMVar-specific blocks
 *
490
 * Stack layout for a thread blocked in takeMVar/readMVar:
491 492 493
 *      
 *       ret. addr
 *       ptr to MVar   (R1)
494
 *       stg_block_takemvar_info (or stg_block_readmvar_info)
495 496 497 498 499 500 501 502 503 504 505 506
 *
 * Stack layout for a thread blocked in putMVar:
 *      
 *       ret. addr
 *       ptr to Value  (R2)
 *       ptr to MVar   (R1)
 *       stg_block_putmvar_info
 *
 * See PrimOps.hc for a description of the workings of take/putMVar.
 * 
 * -------------------------------------------------------------------------- */

507 508
INFO_TABLE_RET ( stg_block_takemvar, RET_SMALL, W_ info_ptr, P_ mvar )
    return ()
509
{
510
    jump stg_takeMVarzh(mvar);
511 512
}

513 514 515
// code fragment executed just before we return to the scheduler
stg_block_takemvar_finally
{
516 517 518
    W_ r1, r3;
    r1 = R1;
    r3 = R3;
519
    unlockClosure(R3, stg_MVAR_DIRTY_info);
520 521
    R1 = r1;
    R3 = r3;
522
    jump StgReturn [R1];
523 524
}

525
stg_block_takemvar /* mvar passed in R1 */
526 527 528 529
{
    Sp_adj(-2);
    Sp(1) = R1;
    Sp(0) = stg_block_takemvar_info;
530
    R3 = R1; // mvar communicated to stg_block_takemvar_finally in R3
531
    BLOCK_BUT_FIRST(stg_block_takemvar_finally);
532 533
}

534
INFO_TABLE_RET ( stg_block_readmvar, RET_SMALL, W_ info_ptr, P_ mvar )
535 536
    return ()
{
537
    jump stg_readMVarzh(mvar);
538 539 540
}

// code fragment executed just before we return to the scheduler
541
stg_block_readmvar_finally
542 543 544 545 546 547 548 549 550 551
{
    W_ r1, r3;
    r1 = R1;
    r3 = R3;
    unlockClosure(R3, stg_MVAR_DIRTY_info);
    R1 = r1;
    R3 = r3;
    jump StgReturn [R1];
}

552
stg_block_readmvar /* mvar passed in R1 */
553 554 555
{
    Sp_adj(-2);
    Sp(1) = R1;
556 557 558
    Sp(0) = stg_block_readmvar_info;
    R3 = R1; // mvar communicated to stg_block_readmvar_finally in R3
    BLOCK_BUT_FIRST(stg_block_readmvar_finally);
559 560
}

561 562 563
INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, W_ info_ptr,
                P_ mvar, P_ val )
    return ()
564
{
565
    jump stg_putMVarzh(mvar, val);
566 567
}

568 569 570
// code fragment executed just before we return to the scheduler
stg_block_putmvar_finally
{
571 572 573
    W_ r1, r3;
    r1 = R1;
    r3 = R3;
574
    unlockClosure(R3, stg_MVAR_DIRTY_info);
575 576
    R1 = r1;
    R3 = r3;
577
    jump StgReturn [R1];
578 579
}

580
stg_block_putmvar (P_ mvar, P_ val)
581
{
582 583 584 585
    push (stg_block_putmvar_info, mvar, val) {
      R3 = R1; // mvar communicated to stg_block_putmvar_finally in R3
      BLOCK_BUT_FIRST(stg_block_putmvar_finally);
   }
586 587
}

588 589 590 591 592
stg_block_blackhole
{
    Sp_adj(-2);
    Sp(1) = R1;
    Sp(0) = stg_enter_info;
593
    BLOCK_GENERIC;
594 595
}

596 597 598
INFO_TABLE_RET ( stg_block_throwto, RET_SMALL, W_ info_ptr,
                 P_ tso, P_ exception )
    return ()
599
{
600
    jump stg_killThreadzh(tso, exception);
601 602 603 604
}

stg_block_throwto_finally
{
605 606 607 608
    // unlock the throwto message, but only if it wasn't already
    // unlocked.  It may have been unlocked if we revoked the message
    // due to an exception being raised during threadPaused().
    if (StgHeader_info(StgTSO_block_info(CurrentTSO)) == stg_WHITEHOLE_info) {
609 610
        W_ r1;
        r1 = R1;
611
        unlockClosure(StgTSO_block_info(CurrentTSO), stg_MSG_THROWTO_info);
612
        R1 = r1;
613
    }
614
    jump StgReturn [R1];
615 616
}

617
stg_block_throwto (P_ tso, P_ exception)
618
{
619 620 621
    push (stg_block_throwto_info, tso, exception) {
       BLOCK_BUT_FIRST(stg_block_throwto_finally);
    }
622 623
}

624
#ifdef mingw32_HOST_OS
625 626
INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ ares )
    return ()
627 628 629
{
    W_ len, errC;

Ian Lynagh's avatar
Ian Lynagh committed
630 631
    len = TO_W_(StgAsyncIOResult_len(ares));
    errC = TO_W_(StgAsyncIOResult_errCode(ares));
632 633
    ccall free(ares "ptr");
    return (len, errC);
634 635 636 637
}

stg_block_async
{
638
    Sp_adj(-2);
639 640 641 642
    Sp(0) = stg_block_async_info;
    BLOCK_GENERIC;
}

sof's avatar
sof committed
643 644 645
/* Used by threadDelay implementation; it would be desirable to get rid of
 * this free()'ing void return continuation.
 */
646 647
INFO_TABLE_RET ( stg_block_async_void, RET_SMALL, W_ info_ptr, W_ ares )
    return ()
sof's avatar
sof committed
648
{
649 650
    ccall free(ares "ptr");
    return ();
sof's avatar
sof committed
651 652 653 654
}

stg_block_async_void
{
655
    Sp_adj(-2);
sof's avatar
sof committed
656 657 658 659
    Sp(0) = stg_block_async_void_info;
    BLOCK_GENERIC;
}

660
#endif
661

662

663 664 665 666 667 668
/* -----------------------------------------------------------------------------
   STM-specific waiting
   -------------------------------------------------------------------------- */

stg_block_stmwait_finally
{
669 670
    ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
    jump StgReturn [R1];
671 672 673 674 675 676
}

stg_block_stmwait
{
    BLOCK_BUT_FIRST(stg_block_stmwait_finally);
}