Per-thread allocation counters and limits
[ghc.git] / rts / HeapStackCheck.cmm
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team, 1998-2004
4  *
5  * Canned Heap-Check and Stack-Check sequences.
6  *
7  * This file is written in a subset of C--, extended with various
8  * features specific to GHC.  It is compiled by GHC directly.  For the
9  * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
10  *
11  * ---------------------------------------------------------------------------*/
12
13 #include "Cmm.h"
14 #include "Updates.h"
15
16 #ifdef __PIC__
17 import pthread_mutex_unlock;
18 #endif
19 import EnterCriticalSection;
20 import LeaveCriticalSection;
21
22 /* Stack/Heap Check Failure
23  * ------------------------
24  *
25  * Both heap and stack check failures end up in the same place, so
26  * that we can share the code for the failure case when a proc needs
27  * both a stack check and a heap check (a common case).
28  *
29  * So when we get here, we have to tell the difference between a stack
30  * check failure and a heap check failure.  The code for the checks
31  * looks like this:
32
33         if (Sp - 16 < SpLim) goto c1Tf;
34         Hp = Hp + 16;
35         if (Hp > HpLim) goto c1Th;
36         ...
37     c1Th:
38         HpAlloc = 16;
39         goto c1Tf;
40     c1Tf: jump stg_gc_enter_1 ();
41
42  * Note that Sp is not decremented by the check, whereas Hp is.  The
43  * reasons for this seem to be largely historic, I can't think of a
44  * good reason not to decrement Sp at the check too. (--SDM)
45  *
46  * Note that HpLim may be set to zero arbitrarily by the timer signal
47  * or another processor to trigger a context switch via heap check
48  * failure.
49  *
50  * The job of these fragments (stg_gc_enter_1 and friends) is to
51  *   1. Leave no slop in the heap, so Hp must be retreated if it was
52  *      incremented by the check.  No-slop is a requirement for LDV
53  *      profiling, at least.
54  *   2. If a heap check failed, try to grab another heap block from
55  *      the nursery and continue.
56  *   3. otherwise, return to the scheduler with StackOverflow,
57  *      HeapOverflow, or ThreadYielding as appropriate.
58  *
59  * We can tell whether Hp was incremented, because HpAlloc is
60  * non-zero: HpAlloc is required to be zero at all times unless a
61  * heap-check just failed, which is why the stack-check failure case
62  * does not set HpAlloc (see code fragment above).  So that covers (1).
63  * HpAlloc is zeroed in LOAD_THREAD_STATE().
64  *
65  * If Hp > HpLim, then either (a) we have reached the end of the
66  * current heap block, or (b) HpLim == 0 and we should yield.  Hence
67  * check Hp > HpLim first, and then HpLim == 0 to decide whether to
68  * return ThreadYielding or try to grab another heap block from the
69  * nursery.
70  *
71  * If Hp <= HpLim, then this must be a StackOverflow.  The scheduler
72  * will either increase the size of our stack, or raise an exception if
73  * the stack is already too big.
74  */
75
76 #define PRE_RETURN(why,what_next)                       \
77   StgTSO_what_next(CurrentTSO) = what_next::I16;        \
78   StgRegTable_rRet(BaseReg) = why;                      \
79   R1 = BaseReg;
80
81 /* Remember that the return address is *removed* when returning to a
82  * ThreadRunGHC thread.
83  */
84
85 stg_gc_noregs
86 {
87     W_ ret;
88
89     DEBUG_ONLY(foreign "C" heapCheckFail());
90     if (Hp > HpLim) {
91         Hp = Hp - HpAlloc/*in bytes*/;
92         if (HpLim == 0) {
93                 ret = ThreadYielding;
94                 goto sched;
95         }
96         if (HpAlloc <= BLOCK_SIZE
97             && bdescr_link(CurrentNursery) != NULL) {
98             HpAlloc = 0;
99             CLOSE_NURSERY();
100             CurrentNursery = bdescr_link(CurrentNursery);
101             OPEN_NURSERY();
102             if (Capability_context_switch(MyCapability()) != 0 :: CInt ||
103                 Capability_interrupt(MyCapability())      != 0 :: CInt ||
104                 (StgTSO_alloc_limit(CurrentTSO) `lt` (0::I64) &&
105                  (TO_W_(StgTSO_flags(CurrentTSO)) & TSO_ALLOC_LIMIT) != 0)) {
106                 ret = ThreadYielding;
107                 goto sched;
108             } else {
109                 jump %ENTRY_CODE(Sp(0)) [];
110             }
111         } else {
112             ret = HeapOverflow;
113             goto sched;
114         }
115     } else {
116         if (CHECK_GC()) {
117             ret = HeapOverflow;
118         } else {
119             ret = StackOverflow;
120         }
121     }
122   sched:
123     PRE_RETURN(ret,ThreadRunGHC);
124     jump stg_returnToSched [R1];
125 }
126
127 #define HP_GENERIC                              \
128     PRE_RETURN(HeapOverflow, ThreadRunGHC)      \
129     jump stg_returnToSched [R1];
130
131 #define BLOCK_GENERIC                           \
132     PRE_RETURN(ThreadBlocked,  ThreadRunGHC)    \
133     jump stg_returnToSched [R1];
134
135 #define YIELD_GENERIC                           \
136     PRE_RETURN(ThreadYielding, ThreadRunGHC)    \
137     jump stg_returnToSched [R1];
138
139 #define BLOCK_BUT_FIRST(c)                      \
140     PRE_RETURN(ThreadBlocked, ThreadRunGHC)     \
141     R2 = c;                                     \
142     jump stg_returnToSchedButFirst [R1,R2,R3];
143
144 #define YIELD_TO_INTERPRETER                    \
145     PRE_RETURN(ThreadYielding, ThreadInterpret) \
146     jump stg_returnToSchedNotPaused [R1];
147
148 /* -----------------------------------------------------------------------------
149    Heap checks in thunks/functions.
150
151    In these cases, node always points to the function closure.  This gives
152    us an easy way to return to the function: just leave R1 on the top of
153    the stack, and have the scheduler enter it to return.
154
155    There are canned sequences for 'n' pointer values in registers.
156    -------------------------------------------------------------------------- */
157
158 INFO_TABLE_RET ( stg_enter, RET_SMALL, W_ info_ptr, P_ closure )
159     return (/* no return values */)
160 {
161     ENTER(closure);
162 }
163
164 __stg_gc_enter_1 (P_ node)
165 {
166     jump stg_gc_noregs (stg_enter_info, node) ();
167 }
168
169 /* -----------------------------------------------------------------------------
170    Canned heap checks for primitives.
171
172    We can't use stg_gc_fun because primitives are not functions, so
173    these fragments let us save some boilerplate heap-check-failure
174    code in a few common cases.
175    -------------------------------------------------------------------------- */
176
177 stg_gc_prim (W_ fun)
178 {
179     call stg_gc_noregs ();
180     jump fun();
181 }
182
183 stg_gc_prim_p (P_ arg, W_ fun)
184 {
185     call stg_gc_noregs ();
186     jump fun(arg);
187 }
188
189 stg_gc_prim_pp (P_ arg1, P_ arg2, W_ fun)
190 {
191     call stg_gc_noregs ();
192     jump fun(arg1,arg2);
193 }
194
195 stg_gc_prim_n (W_ arg, W_ fun)
196 {
197     call stg_gc_noregs ();
198     jump fun(arg);
199 }
200
201 INFO_TABLE_RET(stg_gc_prim_p_ll, RET_SMALL, W_ info, P_ arg, W_ fun)
202     /* explicit stack */
203 {
204     W_ fun;
205     P_ arg;
206     fun = Sp(2);
207     arg = Sp(1);
208     Sp_adj(3);
209     R1 = arg;
210     jump fun [R1];
211 }
212
213 stg_gc_prim_p_ll
214 {
215     W_ fun;
216     P_ arg;
217     fun = R2;
218     arg = R1;
219     Sp_adj(-3);
220     Sp(2) = fun;
221     Sp(1) = arg;
222     Sp(0) = stg_gc_prim_p_ll_info;
223     jump stg_gc_noregs [];
224 }
225
226 /* -----------------------------------------------------------------------------
227    stg_enter_checkbh is just like stg_enter, except that we also call
228    checkBlockingQueues().  The point of this is that the GC can
229    replace an stg_marked_upd_frame with an stg_enter_checkbh if it
230    finds that the BLACKHOLE has already been updated by another
231    thread.  It would be unsafe to use stg_enter, because there might
232    be an orphaned BLOCKING_QUEUE now.
233    -------------------------------------------------------------------------- */
234
235 /* The stg_enter_checkbh frame has the same shape as an update frame: */
236
237 INFO_TABLE_RET ( stg_enter_checkbh, RET_SMALL,
238                  UPDATE_FRAME_FIELDS(W_,P_,info_ptr,ccs,p2,updatee))
239     return (P_ ret)
240 {
241     foreign "C" checkBlockingQueues(MyCapability() "ptr",
242                                     CurrentTSO);
243
244     // we need to return updatee now.  Note that it might be a pointer
245     // to an indirection or a tagged value, we don't know which, so we
246     // need to ENTER() rather than return().
247     ENTER(updatee);
248 }
249
250 /* -----------------------------------------------------------------------------
251    Info tables for returning values of various types.  These are used
252    when we want to push a frame on the stack that will return a value
253    to the frame underneath it.
254    -------------------------------------------------------------------------- */
255
256 INFO_TABLE_RET ( stg_ret_v, RET_SMALL, W_ info_ptr )
257     return (/* no return values */)
258 {
259     return ();
260 }
261
262 INFO_TABLE_RET ( stg_ret_p, RET_SMALL, W_ info_ptr, P_ ptr )
263     return (/* no return values */)
264 {
265     return (ptr);
266 }
267
268 INFO_TABLE_RET ( stg_ret_n, RET_SMALL, W_ info_ptr, W_ nptr )
269     return (/* no return values */)
270 {
271     return (nptr);
272 }
273
274 INFO_TABLE_RET ( stg_ret_f, RET_SMALL, W_ info_ptr, F_ f )
275     return (/* no return values */)
276 {
277     return (f);
278 }
279
280 INFO_TABLE_RET ( stg_ret_d, RET_SMALL, W_ info_ptr, D_ d )
281     return (/* no return values */)
282 {
283     return (d);
284 }
285
286 INFO_TABLE_RET ( stg_ret_l, RET_SMALL, W_ info_ptr, L_ l )
287     return (/* no return values */)
288 {
289     return (l);
290 }
291
292 /* -----------------------------------------------------------------------------
293    Canned heap-check failures for case alts, where we have some values
294    in registers or on the stack according to the NativeReturn
295    convention.
296    -------------------------------------------------------------------------- */
297
298
299 /*-- void return ------------------------------------------------------------ */
300
301 /*-- R1 is a GC pointer, but we don't enter it ----------------------- */
302
303 stg_gc_unpt_r1 return (P_ ptr) /* NB. return convention */
304 {
305     jump stg_gc_noregs (stg_ret_p_info, ptr) ();
306 }
307
308 /*-- R1 is unboxed -------------------------------------------------- */
309
310 stg_gc_unbx_r1 return (W_ nptr) /* NB. return convention */
311 {
312     jump stg_gc_noregs (stg_ret_n_info, nptr) ();
313 }
314
315 /*-- F1 contains a float ------------------------------------------------- */
316
317 stg_gc_f1 return (F_ f)
318 {
319     jump stg_gc_noregs (stg_ret_f_info, f) ();
320 }
321
322 /*-- D1 contains a double ------------------------------------------------- */
323
324 stg_gc_d1 return (D_ d)
325 {
326     jump stg_gc_noregs (stg_ret_d_info, d) ();
327 }
328
329
330 /*-- L1 contains an int64 ------------------------------------------------- */
331
332 stg_gc_l1 return (L_ l)
333 {
334     jump stg_gc_noregs (stg_ret_l_info, l) ();
335 }
336
337 /*-- Unboxed tuples with multiple pointers -------------------------------- */
338
339 stg_gc_pp return (P_ arg1, P_ arg2)
340 {
341     call stg_gc_noregs();
342     return (arg1,arg2);
343 }
344
345 stg_gc_ppp return (P_ arg1, P_ arg2, P_ arg3)
346 {
347     call stg_gc_noregs();
348     return (arg1,arg2,arg3);
349 }
350
351 stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4)
352 {
353     call stg_gc_noregs();
354     return (arg1,arg2,arg3,arg4);
355 }
356
357 /* -----------------------------------------------------------------------------
358    Generic function entry heap check code.
359
360    At a function entry point, the arguments are as per the calling convention,
361    i.e. some in regs and some on the stack.  There may or may not be
362    a pointer to the function closure in R1 - if there isn't, then the heap
363    check failure code in the function will arrange to load it.
364
365    The function's argument types are described in its info table, so we
366    can just jump to this bit of generic code to save away all the
367    registers and return to the scheduler.
368
369    This code arranges the stack like this:
370
371          |        ....         |
372          |        args         |
373          +---------------------+
374          |      f_closure      |
375          +---------------------+
376          |        size         |
377          +---------------------+
378          |   stg_gc_fun_info   |
379          +---------------------+
380
381    The size is the number of words of arguments on the stack, and is cached
382    in the frame in order to simplify stack walking: otherwise the size of
383    this stack frame would have to be calculated by looking at f's info table.
384
385    -------------------------------------------------------------------------- */
386
387 __stg_gc_fun /* explicit stack */
388 {
389     W_ size;
390     W_ info;
391     W_ type;
392
393     info = %GET_FUN_INFO(UNTAG(R1));
394
395     // cache the size
396     type = TO_W_(StgFunInfoExtra_fun_type(info));
397     if (type == ARG_GEN) {
398         size = BITMAP_SIZE(StgFunInfoExtra_bitmap(info));
399     } else {
400         if (type == ARG_GEN_BIG) {
401 #ifdef TABLES_NEXT_TO_CODE
402             // bitmap field holds an offset
403             size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info)
404                                         + %GET_ENTRY(UNTAG(R1)) /* ### */ );
405 #else
406             size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) );
407 #endif
408         } else {
409             size = BITMAP_SIZE(W_[stg_arg_bitmaps + WDS(type)]);
410         }
411     }
412
413 #ifdef NO_ARG_REGS
414     // we don't have to save any registers away
415     Sp_adj(-3);
416     Sp(2) = R1;
417     Sp(1) = size;
418     Sp(0) = stg_gc_fun_info;
419     jump stg_gc_noregs [];
420 #else
421     W_ type;
422     type = TO_W_(StgFunInfoExtra_fun_type(info));
423     // cache the size
424     if (type == ARG_GEN || type == ARG_GEN_BIG) {
425         // regs already saved by the heap check code
426         Sp_adj(-3);
427         Sp(2) = R1;
428         Sp(1) = size;
429         Sp(0) = stg_gc_fun_info;
430         // DEBUG_ONLY(foreign "C" debugBelch("stg_fun_gc_gen(ARG_GEN)"););
431         jump stg_gc_noregs [];
432     } else {
433         jump W_[stg_stack_save_entries + WDS(type)] [*]; // all regs live
434             // jumps to stg_gc_noregs after saving stuff
435     }
436 #endif /* !NO_ARG_REGS */
437 }
438
439
440 /* -----------------------------------------------------------------------------
441    Generic Apply (return point)
442
443    The dual to stg_fun_gc_gen (above): this fragment returns to the
444    function, passing arguments in the stack and in registers
445    appropriately.  The stack layout is given above.
446    -------------------------------------------------------------------------- */
447
448 INFO_TABLE_RET ( stg_gc_fun, RET_FUN )
449     /* explicit stack */
450 {
451     R1 = Sp(2);
452     Sp_adj(3);
453 #ifdef NO_ARG_REGS
454     // Minor optimisation: there are no argument registers to load up,
455     // so we can just jump straight to the function's entry point.
456     jump %GET_ENTRY(UNTAG(R1)) [R1];
457 #else
458     W_ info;
459     W_ type;
460
461     info = %GET_FUN_INFO(UNTAG(R1));
462     type = TO_W_(StgFunInfoExtra_fun_type(info));
463     if (type == ARG_GEN || type == ARG_GEN_BIG) {
464         jump StgFunInfoExtra_slow_apply(info) [R1];
465     } else {
466         if (type == ARG_BCO) {
467             // cover this case just to be on the safe side
468             Sp_adj(-2);
469             Sp(1) = R1;
470             Sp(0) = stg_apply_interp_info;
471             jump stg_yield_to_interpreter [];
472         } else {
473             jump W_[stg_ap_stack_entries + WDS(type)] [R1];
474         }
475     }
476 #endif
477 }
478
479 /* -----------------------------------------------------------------------------
480    Yields
481    -------------------------------------------------------------------------- */
482
483 stg_yield_noregs
484 {
485     YIELD_GENERIC;
486 }
487
488 /* -----------------------------------------------------------------------------
489    Yielding to the interpreter... top of stack says what to do next.
490    -------------------------------------------------------------------------- */
491
492 stg_yield_to_interpreter
493 {
494     YIELD_TO_INTERPRETER;
495 }
496
497 /* -----------------------------------------------------------------------------
498    Blocks
499    -------------------------------------------------------------------------- */
500
501 stg_block_noregs
502 {
503     BLOCK_GENERIC;
504 }
505
506 /* -----------------------------------------------------------------------------
507  * takeMVar/putMVar-specific blocks
508  *
509  * Stack layout for a thread blocked in takeMVar/readMVar:
510  *
511  *       ret. addr
512  *       ptr to MVar   (R1)
513  *       stg_block_takemvar_info (or stg_block_readmvar_info)
514  *
515  * Stack layout for a thread blocked in putMVar:
516  *
517  *       ret. addr
518  *       ptr to Value  (R2)
519  *       ptr to MVar   (R1)
520  *       stg_block_putmvar_info
521  *
522  * See PrimOps.hc for a description of the workings of take/putMVar.
523  *
524  * -------------------------------------------------------------------------- */
525
526 INFO_TABLE_RET ( stg_block_takemvar, RET_SMALL, W_ info_ptr, P_ mvar )
527     return ()
528 {
529     jump stg_takeMVarzh(mvar);
530 }
531
532 // code fragment executed just before we return to the scheduler
533 stg_block_takemvar_finally
534 {
535     W_ r1, r3;
536     r1 = R1;
537     r3 = R3;
538     unlockClosure(R3, stg_MVAR_DIRTY_info);
539     R1 = r1;
540     R3 = r3;
541     jump StgReturn [R1];
542 }
543
544 stg_block_takemvar /* mvar passed in R1 */
545 {
546     Sp_adj(-2);
547     Sp(1) = R1;
548     Sp(0) = stg_block_takemvar_info;
549     R3 = R1; // mvar communicated to stg_block_takemvar_finally in R3
550     BLOCK_BUT_FIRST(stg_block_takemvar_finally);
551 }
552
553 INFO_TABLE_RET ( stg_block_readmvar, RET_SMALL, W_ info_ptr, P_ mvar )
554     return ()
555 {
556     jump stg_readMVarzh(mvar);
557 }
558
559 // code fragment executed just before we return to the scheduler
560 stg_block_readmvar_finally
561 {
562     W_ r1, r3;
563     r1 = R1;
564     r3 = R3;
565     unlockClosure(R3, stg_MVAR_DIRTY_info);
566     R1 = r1;
567     R3 = r3;
568     jump StgReturn [R1];
569 }
570
571 stg_block_readmvar /* mvar passed in R1 */
572 {
573     Sp_adj(-2);
574     Sp(1) = R1;
575     Sp(0) = stg_block_readmvar_info;
576     R3 = R1; // mvar communicated to stg_block_readmvar_finally in R3
577     BLOCK_BUT_FIRST(stg_block_readmvar_finally);
578 }
579
580 INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, W_ info_ptr,
581                 P_ mvar, P_ val )
582     return ()
583 {
584     jump stg_putMVarzh(mvar, val);
585 }
586
587 // code fragment executed just before we return to the scheduler
588 stg_block_putmvar_finally
589 {
590     W_ r1, r3;
591     r1 = R1;
592     r3 = R3;
593     unlockClosure(R3, stg_MVAR_DIRTY_info);
594     R1 = r1;
595     R3 = r3;
596     jump StgReturn [R1];
597 }
598
599 stg_block_putmvar (P_ mvar, P_ val)
600 {
601     push (stg_block_putmvar_info, mvar, val) {
602       R3 = R1; // mvar communicated to stg_block_putmvar_finally in R3
603       BLOCK_BUT_FIRST(stg_block_putmvar_finally);
604    }
605 }
606
607 stg_block_blackhole
608 {
609     Sp_adj(-2);
610     Sp(1) = R1;
611     Sp(0) = stg_enter_info;
612     BLOCK_GENERIC;
613 }
614
615 INFO_TABLE_RET ( stg_block_throwto, RET_SMALL, W_ info_ptr,
616                  P_ tso, P_ exception )
617     return ()
618 {
619     jump stg_killThreadzh(tso, exception);
620 }
621
622 stg_block_throwto_finally
623 {
624     // unlock the throwto message, but only if it wasn't already
625     // unlocked.  It may have been unlocked if we revoked the message
626     // due to an exception being raised during threadPaused().
627     if (StgHeader_info(StgTSO_block_info(CurrentTSO)) == stg_WHITEHOLE_info) {
628         W_ r1;
629         r1 = R1;
630         unlockClosure(StgTSO_block_info(CurrentTSO), stg_MSG_THROWTO_info);
631         R1 = r1;
632     }
633     jump StgReturn [R1];
634 }
635
636 stg_block_throwto (P_ tso, P_ exception)
637 {
638     push (stg_block_throwto_info, tso, exception) {
639        BLOCK_BUT_FIRST(stg_block_throwto_finally);
640     }
641 }
642
643 #ifdef mingw32_HOST_OS
644 INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ ares )
645     return ()
646 {
647     W_ len, errC;
648
649     len = TO_W_(StgAsyncIOResult_len(ares));
650     errC = TO_W_(StgAsyncIOResult_errCode(ares));
651     ccall free(ares "ptr");
652     return (len, errC);
653 }
654
655 stg_block_async
656 {
657     Sp_adj(-2);
658     Sp(0) = stg_block_async_info;
659     BLOCK_GENERIC;
660 }
661
662 /* Used by threadDelay implementation; it would be desirable to get rid of
663  * this free()'ing void return continuation.
664  */
665 INFO_TABLE_RET ( stg_block_async_void, RET_SMALL, W_ info_ptr, W_ ares )
666     return ()
667 {
668     ccall free(ares "ptr");
669     return ();
670 }
671
672 stg_block_async_void
673 {
674     Sp_adj(-2);
675     Sp(0) = stg_block_async_void_info;
676     BLOCK_GENERIC;
677 }
678
679 #endif
680
681
682 /* -----------------------------------------------------------------------------
683    STM-specific waiting
684    -------------------------------------------------------------------------- */
685
686 stg_block_stmwait
687 {
688     // When blocking on an MVar we have to be careful to only release
689     // the lock on the MVar at the very last moment (using
690     // BLOCK_BUT_FIRST()), since when we release the lock another
691     // Capability can wake up the thread, which modifies its stack and
692     // other state.  This is not a problem for STM, because STM
693     // wakeups are non-destructive; the waker simply calls
694     // tryWakeupThread() which sends a message to the owner
695     // Capability.  So the moment we release this lock we might start
696     // getting wakeup messages, but that's perfectly harmless.
697     //
698     // Furthermore, we *must* release these locks, just in case an
699     // exception is raised in this thread by
700     // maybePerformBlockedException() while exiting to the scheduler,
701     // which will abort the transaction, which needs to obtain a lock
702     // on all the TVars to remove the thread from the queues.
703     //
704     ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
705     BLOCK_GENERIC;
706 }