diff options
Diffstat (limited to 'rts/Apply.cmm')
| -rw-r--r-- | rts/Apply.cmm | 268 |
1 files changed, 268 insertions, 0 deletions
diff --git a/rts/Apply.cmm b/rts/Apply.cmm new file mode 100644 index 0000000000..e0ca03944c --- /dev/null +++ b/rts/Apply.cmm @@ -0,0 +1,268 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2004 + * + * Application-related bits. + * + * 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" + +/* ---------------------------------------------------------------------------- + * Evaluate a closure and return it. + * + * There isn't an info table / return address version of stg_ap_0, because + * everything being returned is guaranteed evaluated, so it would be a no-op. + */ + +STRING(stg_ap_0_ret_str,"stg_ap_0_ret... ") + +stg_ap_0_fast +{ + // fn is in R1, no args on the stack + + IF_DEBUG(apply, + foreign "C" debugBelch(stg_ap_0_ret_str) [R1]; + foreign "C" printClosure(R1 "ptr") [R1]); + + IF_DEBUG(sanity, + foreign "C" checkStackChunk(Sp "ptr", + CurrentTSO + TSO_OFFSET_StgTSO_stack + + WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) "ptr") [R1]); + + ENTER(); +} + +/* ----------------------------------------------------------------------------- + Entry Code for a PAP. + + This entry code is *only* called by one of the stg_ap functions. + On entry: Sp points to the remaining arguments on the stack. If + the stack check fails, we can just push the PAP on the stack and + return to the scheduler. + + On entry: R1 points to the PAP. The rest of the function's + arguments (apart from those that are already in the PAP) are on the + stack, starting at Sp(0). R2 contains an info table which + describes these arguments, which is used in the event that the + stack check in the entry code below fails. The info table is + currently one of the stg_ap_*_ret family, as this code is always + entered from those functions. + + The idea is to copy the chunk of stack from the PAP object onto the + stack / into registers, and enter the function. + -------------------------------------------------------------------------- */ + +INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP") +{ foreign "C" barf("PAP object entered!"); } + +stg_PAP_apply +{ + W_ Words; + W_ pap; + + pap = R1; + + Words = TO_W_(StgPAP_n_args(pap)); + + // + // Check for stack overflow and bump the stack pointer. + // We have a hand-rolled stack check fragment here, because none of + // the canned ones suit this situation. + // + if ((Sp - WDS(Words)) < SpLim) { + // there is a return address in R2 in the event of a + // stack check failure. The various stg_apply functions arrange + // this before calling stg_PAP_entry. + Sp_adj(-1); + Sp(0) = R2; + jump stg_gc_unpt_r1; + } + Sp_adj(-Words); + + // profiling + TICK_ENT_PAP(); + LDV_ENTER(pap); + // Enter PAP cost centre + ENTER_CCS_PAP_CL(pap); + + R1 = StgPAP_fun(pap); + + // Reload the stack + W_ i; + W_ p; + p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload; + i = 0; +for: + if (i < Words) { + Sp(i) = W_[p]; + p = p + WDS(1); + i = i + 1; + goto for; + } + + // Off we go! + TICK_ENT_VIA_NODE(); + +#ifdef NO_ARG_REGS + jump %GET_ENTRY(R1); +#else + W_ info; + info = %GET_FUN_INFO(R1); + W_ type; + type = TO_W_(StgFunInfoExtra_fun_type(info)); + if (type == ARG_GEN) { + jump StgFunInfoExtra_slow_apply(info); + } + if (type == ARG_GEN_BIG) { + jump StgFunInfoExtra_slow_apply(info); + } + if (type == ARG_BCO) { + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; + jump stg_yield_to_interpreter; + } + jump W_[stg_ap_stack_entries + + WDS(TO_W_(StgFunInfoExtra_fun_type(info)))]; +#endif +} + +/* ----------------------------------------------------------------------------- + Entry Code for an AP (a PAP with arity zero). + + The entry code is very similar to a PAP, except there are no + further arguments on the stack to worry about, so the stack check + is simpler. We must also push an update frame on the stack before + applying the function. + -------------------------------------------------------------------------- */ + +INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP") +{ + W_ Words; + W_ ap; + + ap = R1; + + Words = TO_W_(StgAP_n_args(ap)); + + /* + * Check for stack overflow. IMPORTANT: use a _NP check here, + * because if the check fails, we might end up blackholing this very + * closure, in which case we must enter the blackhole on return rather + * than continuing to evaluate the now-defunct closure. + */ + STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame); + + PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); + Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words); + + TICK_ENT_AP(); + LDV_ENTER(ap); + + // Enter PAP cost centre + ENTER_CCS_PAP_CL(ap); // ToDo: ENTER_CC_AP_CL + + R1 = StgAP_fun(ap); + + // Reload the stack + W_ i; + W_ p; + p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload; + i = 0; +for: + if (i < Words) { + Sp(i) = W_[p]; + p = p + WDS(1); + i = i + 1; + goto for; + } + + // Off we go! + TICK_ENT_VIA_NODE(); + +#ifdef NO_ARG_REGS + jump %GET_ENTRY(R1); +#else + W_ info; + info = %GET_FUN_INFO(R1); + W_ type; + type = TO_W_(StgFunInfoExtra_fun_type(info)); + if (type == ARG_GEN) { + jump StgFunInfoExtra_slow_apply(info); + } + if (type == ARG_GEN_BIG) { + jump StgFunInfoExtra_slow_apply(info); + } + if (type == ARG_BCO) { + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; + jump stg_yield_to_interpreter; + } + jump W_[stg_ap_stack_entries + + WDS(TO_W_(StgFunInfoExtra_fun_type(info)))]; +#endif +} + +/* ----------------------------------------------------------------------------- + Entry Code for an AP_STACK. + + Very similar to a PAP and AP. The layout is the same as PAP + and AP, except that the payload is a chunk of stack instead of + being described by the function's info table. Like an AP, + there are no further arguments on the stack to worry about. + However, the function closure (ap->fun) does not necessarily point + directly to a function, so we have to enter it using stg_ap_0. + -------------------------------------------------------------------------- */ + +INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK") +{ + W_ Words; + W_ ap; + + ap = R1; + + Words = StgAP_STACK_size(ap); + + /* + * Check for stack overflow. IMPORTANT: use a _NP check here, + * because if the check fails, we might end up blackholing this very + * closure, in which case we must enter the blackhole on return rather + * than continuing to evaluate the now-defunct closure. + */ + STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame); + + PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); + Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words); + + TICK_ENT_AP(); + LDV_ENTER(ap); + + // Enter PAP cost centre + ENTER_CCS_PAP_CL(ap); // ToDo: ENTER_CC_AP_CL + + R1 = StgAP_STACK_fun(ap); + + // Reload the stack + W_ i; + W_ p; + p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload; + i = 0; +for: + if (i < Words) { + Sp(i) = W_[p]; + p = p + WDS(1); + i = i + 1; + goto for; + } + + // Off we go! + TICK_ENT_VIA_NODE(); + + ENTER(); +} |