+++ /dev/null
-/* -----------------------------------------------------------------------------
- *
- * (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();
-}
projects / ghc-hetmet.git / blobdiff