summaryrefslogtreecommitdiff
path: root/rts/Apply.cmm
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
committerSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
commit0065d5ab628975892cea1ec7303f968c3338cbe1 (patch)
tree8e2afe0ab48ee33cf95009809d67c9649573ef92 /rts/Apply.cmm
parent28a464a75e14cece5db40f2765a29348273ff2d2 (diff)
downloadhaskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to Cabal, and with the move to darcs we can now flatten the source tree without losing history, so here goes. The main change is that the ghc/ subdir is gone, and most of what it contained is now at the top level. The build system now makes no pretense at being multi-project, it is just the GHC build system. No doubt this will break many things, and there will be a period of instability while we fix the dependencies. A straightforward build should work, but I haven't yet fixed binary/source distributions. Changes to the Building Guide will follow, too.
Diffstat (limited to 'rts/Apply.cmm')
-rw-r--r--rts/Apply.cmm268
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();
+}