[project @ 2003-07-21 11:01:06 by simonmar]

When restoring the cost centre in a let-no-escape, don't free the
stack slot containing it.  We might need the saved cost centre again
for a recursive call to this let-no-escape.

Should fix profiling a bit more.

2 files changed, 16 insertions, 12 deletions

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 92d5bba346..e93d64cbd2 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.64 2003/07/02 13:18:24 simonpj Exp $
+% $Id: CgCase.lhs,v 1.65 2003/07/21 11:01:06 simonmar Exp $
 %
 %********************************************************
 %*							*
@@ -361,7 +361,7 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
     
     forkAbsC (	-- forkAbsC for the RHS, so that the envt is
 		-- not changed for the mkRetDirect call
-  	restoreCurrentCostCentre cc_slot	`thenC` 
+  	restoreCurrentCostCentre cc_slot True	`thenC` 
 	bindUnboxedTupleComponents args		`thenFC` \ (live_regs, ptrs, nptrs, _) ->
 		-- Generate a heap check if necessary
   	unbxTupleHeapCheck live_regs ptrs nptrs AbsCNop $
@@ -374,7 +374,7 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
 cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts
   = forkAbsC (	-- forkAbsC for the RHS, so that the envt is
 		-- not changed for the mkRetDirect call
-  	restoreCurrentCostCentre cc_slot		`thenC` 
+  	restoreCurrentCostCentre cc_slot True		`thenC` 
 	bindNewToReg bndr reg (mkLFArgument bndr)	`thenC`
 	cgPrimAlts GCMayHappen (CReg reg) alts alt_type
     ) 						`thenFC` \ abs_c ->
@@ -463,7 +463,7 @@ cgAlgAlt :: GCFlag
 cgAlgAlt gc_flag uniq cc_slot must_label_branch
          alt_type (con, args, use_mask, rhs)
   = getAbsC (bind_con_args con args		`thenFC` \ _ ->
-    	     restoreCurrentCostCentre cc_slot	`thenC`
+    	     restoreCurrentCostCentre cc_slot True	`thenC`
 	     maybeAltHeapCheck gc_flag alt_type (cgExpr rhs)
     ) 						`thenFC` \ abs_c -> 
     let
@@ -655,11 +655,13 @@ saveCurrentCostCentre
 	returnFC (Just slot,
 		  CAssign (CVal sp_rel CostCentreRep) (CReg CurCostCentre))
 
-restoreCurrentCostCentre :: Maybe VirtualSpOffset -> Code
-restoreCurrentCostCentre Nothing = nopC
-restoreCurrentCostCentre (Just slot)
- = getSpRelOffset slot				 `thenFC` \ sp_rel ->
-   freeStackSlots [slot]			 `thenC`
+-- Sometimes we don't free the slot containing the cost centre after restoring it
+-- (see CgLetNoEscape.cgLetNoEscapeBody).
+restoreCurrentCostCentre :: Maybe VirtualSpOffset -> Bool -> Code
+restoreCurrentCostCentre Nothing     _freeit = nopC
+restoreCurrentCostCentre (Just slot) freeit
+ = getSpRelOffset slot				     `thenFC` \ sp_rel ->
+   (if freeit then freeStackSlots [slot] else nopC)  `thenC`
    absC (CCallProfCCMacro FSLIT("RESTORE_CCCS") [CVal sp_rel CostCentreRep])
     -- we use the RESTORE_CCCS macro, rather than just
     -- assigning into CurCostCentre, in case RESTORE_CCCS
diff --git a/ghc/compiler/codeGen/CgLetNoEscape.lhs b/ghc/compiler/codeGen/CgLetNoEscape.lhs
index a9c550120b..80b80ee6b2 100644
--- a/ghc/compiler/codeGen/CgLetNoEscape.lhs
+++ b/ghc/compiler/codeGen/CgLetNoEscape.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
 %
-% $Id: CgLetNoEscape.lhs,v 1.23 2003/07/18 16:31:27 simonmar Exp $
+% $Id: CgLetNoEscape.lhs,v 1.24 2003/07/21 11:01:07 simonmar Exp $
 %
 %********************************************************
 %*							*
@@ -188,8 +188,10 @@ cgLetNoEscapeBody :: Id		-- Name of the joint point
 cgLetNoEscapeBody bndr cc cc_slot all_args body
    = bindUnboxedTupleComponents all_args	`thenFC` \ (arg_regs, ptrs, nptrs, ret_slot) ->
 
-     -- restore the saved cost centre
-     restoreCurrentCostCentre cc_slot	`thenC`
+     -- restore the saved cost centre.  BUT: we must not free the stack slot
+     -- containing the cost centre, because it might be needed for a
+     -- recursive call to this let-no-escape.
+     restoreCurrentCostCentre cc_slot False{-don't free-}	`thenC`
 
 	-- Enter the closures cc, if required
      --enterCostCentreCode closure_info cc IsFunction  `thenC`