--- /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.
+ *
+ * stg_ap_0_info <--- Sp
+ *
+ * NOTE: this needs to be a polymorphic return point, because we can't
+ * be sure that the thing being evaluated is not a function.
+ */
+
+#if MAX_VECTORED_RTN > 8
+#error MAX_VECTORED_RTN has changed: please modify stg_ap_0 too.
+#endif
+
+STRING(stg_ap_0_ret_str,"stg_ap_0_ret... ")
+
+INFO_TABLE_RET( stg_ap_0,
+ 0/*framsize*/, 0/*bitmap*/, RET_SMALL,
+ RET_LBL(stg_ap_0),
+ RET_LBL(stg_ap_0),
+ RET_LBL(stg_ap_0),
+ RET_LBL(stg_ap_0),
+ RET_LBL(stg_ap_0),
+ RET_LBL(stg_ap_0),
+ RET_LBL(stg_ap_0),
+ RET_LBL(stg_ap_0) )
+{
+ // fn is in R1, no args on the stack
+
+ IF_DEBUG(apply,
+ foreign "C" fprintf(stderr, stg_ap_0_ret_str);
+ foreign "C" printClosure(R1 "ptr"));
+
+ IF_DEBUG(sanity,
+ foreign "C" checkStackChunk(Sp+WDS(1) "ptr",
+ CurrentTSO + OFFSET_StgTSO_stack +
+ WDS(StgTSO_stack_size(CurrentTSO)) "ptr"));
+
+ Sp_adj(1);
+ 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")
+{
+ 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