From: simonmar <unknown>
Date: Fri, 10 Jan 2003 15:00:22 +0000 (+0000)
Subject: [project @ 2003-01-10 15:00:22 by simonmar]
X-Git-Tag: Approx_11550_changesets_converted~1271
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e60d7bb1d012cc1c6425222e8948cc10f8af664f;p=ghc-hetmet.git

[project @ 2003-01-10 15:00:22 by simonmar]
Fix GHCi breakage on the HEAD: my recent fixes to the BCO cases in
GenApply weren't quite correct.
---

diff --git a/ghc/rts/Apply.hc b/ghc/rts/Apply.hc
index fc445c9..d8999f1 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,13 +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) {
-      // 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);
diff --git a/ghc/utils/genapply/GenApply.hs b/ghc/utils/genapply/GenApply.hs
index 99b91d2..b2486c0 100644
--- a/ghc/utils/genapply/GenApply.hs
+++ b/ghc/utils/genapply/GenApply.hs
@@ -141,7 +141,7 @@ mkApplyRetName args
 mkApplyInfoName args
   = text "stg_ap_" <> text (map showArg args) <> text "_info"
 
-genMkPAP macro jump is_pap args all_args_size fun_info_label
+genMkPAP macro jump stack_apply is_pap args all_args_size fun_info_label
   =  smaller_arity_cases
   $$ exact_arity_case
   $$ larger_arity_case
@@ -161,8 +161,8 @@ genMkPAP macro jump is_pap args all_args_size fun_info_label
         =  text "if (arity == " <> int arity <> text ") {" $$
 	   let
 	     (reg_doc, sp')
-		| is_pap    = (empty, 1)
-		| otherwise = loadRegArgs 1 these_args
+		| stack_apply = (empty, 1)
+		| otherwise   = loadRegArgs 1 these_args
 	   in
            nest 4 (vcat [
 	     reg_doc,
@@ -174,7 +174,7 @@ genMkPAP macro jump is_pap args all_args_size fun_info_label
 		-- return address in the even that stg_PAP_entry fails its
 		-- heap check.  See stg_PAP_entry in Apply.hc for details.
 	     if is_pap 
-		then text "Sp--; Sp[0] = (W_)&" <> mkApplyInfoName these_args <> semi
+		then text "R2.w = (W_)&" <> mkApplyInfoName these_args <> semi
 		else empty,
 	     text "JMP_" <> parens (text jump) <> semi
 	    ]) $$
@@ -197,14 +197,14 @@ genMkPAP macro jump is_pap args all_args_size fun_info_label
 	= text "if (arity == " <> int n_args <> text ") {" $$
 	  let
 	     (reg_doc, sp')
-		| is_pap    = (empty, 0)
-		| otherwise = loadRegArgs 1 args
+		| stack_apply = (empty, 1)
+		| otherwise   = loadRegArgs 1 args
 	  in
 	  nest 4 (vcat [
 	    reg_doc,
 	    text "Sp += " <> int sp' <> semi,
 	    if is_pap 
-		then text "Sp[0] = (W_)&" <> fun_info_label <> semi
+		then text "R2.w = (W_)&" <> fun_info_label <> semi
 		else empty,
 	    text "JMP_" <> parens (text jump) <> semi
 	  ])
@@ -246,7 +246,6 @@ genApply args =
       text "F_ " <> fun_ret_label <> text "( void )\n{",
       nest 4 (vcat [
        text "StgInfoTable *info;",
-       text "F_ target;",
        text "nat arity;",
 
 --    if fast == 1:
@@ -312,8 +311,10 @@ genApply args =
 	text "case BCO:",
 	nest 4 (vcat [
 	  text "arity = BCO_ARITY((StgBCO *)R1.p);",
-	  text "target = (F_)&stg_BCO_entry;",
-	  text "goto apply_pap;"
+	  text "ASSERT(arity > 0);",
+	  genMkPAP "BUILD_PAP" "stg_BCO_entry" 
+		True{-stack apply-} False{-not a PAP-}
+		args all_args_size fun_info_label
 	 ]),
 
 --    if fast == 1:
@@ -329,7 +330,8 @@ genApply args =
 	nest 4 (vcat [
 	  text "arity = itbl_to_fun_itbl(info)->arity;",
 	  text "ASSERT(arity > 0);",
-          genMkPAP "BUILD_PAP" "GET_ENTRY(R1.cl)" False{-not PAP-}
+          genMkPAP "BUILD_PAP" "GET_ENTRY(R1.cl)" 
+		False{-reg apply-} False{-not a PAP-}
 		args all_args_size fun_info_label
 	 ]),
 
@@ -340,10 +342,9 @@ genApply args =
 	text "case PAP:",
 	nest 4 (vcat [
  	  text "arity = ((StgPAP *)R1.p)->arity;",
-	  text "target = (F_)&stg_PAP_entry;",
-	  text "apply_pap:",
 	  text "ASSERT(arity > 0);",
-	  genMkPAP "NEW_PAP" "target" True{-is PAP-}
+	  genMkPAP "NEW_PAP" "stg_PAP_entry" 
+		True{-stack apply-} True{-is a PAP-}
 		args all_args_size fun_info_label
 	 ]),