X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FApply.hc;h=30fbb5017b8ed05edebea1e6bd6d681bbc12136b;hb=272a418428beede04a9c4ae027474878c59d6ca1;hp=39ca48848c38c612f60fee9b111660ce4035c02e;hpb=491f66f835964bbcfa8f7acf46bc2bd1443be679;p=ghc-hetmet.git

diff --git a/ghc/rts/Apply.hc b/ghc/rts/Apply.hc
index 39ca488..30fbb50 100644
--- a/ghc/rts/Apply.hc
+++ b/ghc/rts/Apply.hc
@@ -64,8 +64,13 @@ stg_ap_0_ret(void)
    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
-   (*all* of 'em) are on the stack, starting at Sp[0].
+   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.
@@ -88,14 +93,14 @@ STGFUN(stg_PAP_entry)
   // We have a hand-rolled stack check fragment here, because none of
   // the canned ones suit this situation.
   if ((Sp - Words) < SpLim) {
-      DEBUG_ONLY(fprintf(stderr,"PAP STACK CHECK!\n"));
-      // there is a return address on the stack in the event of a
+      // 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--; 
+      Sp[0] = R2.w;
       JMP_(stg_gc_unpt_r1);
   }
-  // Sp is already pointing one word below the arguments...
-  Sp -= Words-1;
+  Sp -= Words;
 
   // profiling
   TICK_ENT_PAP(pap);
@@ -122,6 +127,11 @@ STGFUN(stg_PAP_entry)
       info = get_fun_itbl(R1.cl);
       if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
 	  JMP_(info->slow_apply);
+      } else if (info->fun_type == ARG_BCO) {
+	  Sp -= 2;
+	  Sp[1] = R1.w;
+	  Sp[0] = (W_)&stg_apply_interp_info;
+	  JMP_(stg_yield_to_interpreter);
       } else {
 	  JMP_(stg_ap_stack_entries[info->fun_type]);
       }
@@ -129,3 +139,123 @@ STGFUN(stg_PAP_entry)
 #endif
   FE_
 }
+
+/* -----------------------------------------------------------------------------
+   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_info,stg_AP_entry,/*special layout*/0,0,AP,,EF_,"AP","AP");
+STGFUN(stg_AP_entry)
+{
+  nat Words;
+  P_ p;
+  nat i;
+  StgAP *ap;
+
+  FB_
+    
+  ap = (StgAP *) R1.p;
+  
+  Words = ap->n_args;
+
+  // 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(Words+sizeofW(StgUpdateFrame),);
+
+  PUSH_UPD_FRAME(R1.p, 0);
+  Sp -= sizeofW(StgUpdateFrame) + Words;
+
+  TICK_ENT_AP(ap);
+  LDV_ENTER(ap);
+
+  // Enter PAP cost centre -- lexical scoping only
+  ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_CL */
+
+  R1.cl = ap->fun;
+  p = (P_)(ap->payload);
+
+  // Reload the stack
+  for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
+
+  // Off we go!
+  TICK_ENT_VIA_NODE();
+
+#ifdef NO_ARG_REGS
+  JMP_(GET_ENTRY(R1.cl));
+#else
+  {
+      StgFunInfoTable *info;
+      info = get_fun_itbl(R1.cl);
+      if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
+	  JMP_(info->slow_apply);
+      } else if (info->fun_type == ARG_BCO) {
+	  Sp -= 2;
+	  Sp[1] = R1.w;
+	  Sp[0] = (W_)&stg_apply_interp_info;
+	  JMP_(stg_yield_to_interpreter);
+      } else {
+	  JMP_(stg_ap_stack_entries[info->fun_type]);
+      }
+  }
+#endif
+  FE_
+}
+
+/* -----------------------------------------------------------------------------
+   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_info,stg_AP_STACK_entry,/*special layout*/0,0,AP_STACK,,EF_,"AP_STACK","AP_STACK");
+STGFUN(stg_AP_STACK_entry)
+{
+  nat Words;
+  P_ p;
+  nat i;
+  StgAP_STACK *ap;
+
+  FB_
+    
+  ap = (StgAP_STACK *) R1.p;
+  
+  Words = ap->size;
+
+  // 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(Words+sizeofW(StgUpdateFrame),);
+
+  PUSH_UPD_FRAME(R1.p, 0);
+  Sp -= sizeofW(StgUpdateFrame) + Words;
+
+  TICK_ENT_AP(ap);
+  LDV_ENTER(ap);
+
+  // Enter PAP cost centre -- lexical scoping only */
+  ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_STACK_CL */
+
+  R1.cl = ap->fun;
+  p = (P_)(ap->payload);
+
+  // Reload the stack
+  for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
+
+  // Off we go!
+  TICK_ENT_VIA_NODE();
+  ENTER();
+  FE_
+}