Detab TcUnify

[ghc-hetmet.git] / rts / Apply.cmm

diff --git a/rts/Apply.cmm b/rts/Apply.cmm
index e0ca039..a98edee 100644 (file)
--- a/rts/Apply.cmm
+++ b/rts/Apply.cmm
@@ -58,7 +58,7 @@ stg_ap_0_fast
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
-{  foreign "C" barf("PAP object entered!"); }
+{  foreign "C" barf("PAP object entered!") never returns; }
     
 stg_PAP_apply
 {
@@ -90,8 +90,6 @@ stg_PAP_apply
   // Enter PAP cost centre 
   ENTER_CCS_PAP_CL(pap);
 
-  R1 = StgPAP_fun(pap);
-
   // Reload the stack 
   W_ i;
   W_ p;
@@ -105,14 +103,30 @@ for:
     goto for;
   }
 
+  R1 = StgPAP_fun(pap);
+
+/* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged
+  if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) {
+    if (GETTAG(R1)!=1) {
+       W_[0]=1;
+    }
+  }
+
+  if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) {
+    if (GETTAG(R1)!=2) {
+       W_[0]=1;
+    }
+  }
+*/
+
   // Off we go! 
   TICK_ENT_VIA_NODE();
 
 #ifdef NO_ARG_REGS
-  jump %GET_ENTRY(R1);
+  jump %GET_ENTRY(UNTAG(R1));
 #else
       W_ info;
-      info = %GET_FUN_INFO(R1);
+      info = %GET_FUN_INFO(UNTAG(R1));
       W_ type;
       type = TO_W_(StgFunInfoExtra_fun_type(info));
       if (type == ARG_GEN) {
@@ -167,8 +181,76 @@ INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
   // Enter PAP cost centre
   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
 
+  // 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;
+  }
+
   R1 = StgAP_fun(ap);
 
+  // Off we go! 
+  TICK_ENT_VIA_NODE();
+
+#ifdef NO_ARG_REGS
+  jump %GET_ENTRY(UNTAG(R1));
+#else
+      W_ info;
+      info = %GET_FUN_INFO(UNTAG(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
+}
+
+/* AP_NOUPD is exactly like AP, except that no update frame is pushed.
+   Use for thunks that are guaranteed to be entered once only, such as 
+   those generated by the byte-code compiler for inserting breakpoints. */
+
+INFO_TABLE(stg_AP_NOUPD,/*special layout*/0,0,AP,"AP_NOUPD","AP_NOUPD")
+{
+  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));
+  Sp = Sp - WDS(Words);
+
+  TICK_ENT_AP();
+  LDV_ENTER(ap);
+
+  // Enter PAP cost centre
+  ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
+
   // Reload the stack 
   W_ i;
   W_ p;
@@ -182,14 +264,16 @@ for:
     goto for;
   }
 
+  R1 = StgAP_fun(ap);
+
   // Off we go! 
   TICK_ENT_VIA_NODE();
 
 #ifdef NO_ARG_REGS
-  jump %GET_ENTRY(R1);
+  jump %GET_ENTRY(UNTAG(R1));
 #else
       W_ info;
-      info = %GET_FUN_INFO(R1);
+      info = %GET_FUN_INFO(UNTAG(R1));
       W_ type;
       type = TO_W_(StgFunInfoExtra_fun_type(info));
       if (type == ARG_GEN) {
@@ -235,7 +319,9 @@ INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
    * 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);
+  STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM));
+  /* ensure there is at least AP_STACK_SPLIM words of headroom available
+   * after unpacking the AP_STACK. See bug #1466 */
 
   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
@@ -246,8 +332,6 @@ INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
   // 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;
@@ -264,5 +348,7 @@ for:
   // Off we go!
   TICK_ENT_VIA_NODE();
 
+  R1 = StgAP_STACK_fun(ap);
+
   ENTER();
 }