[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.

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 92d5bba..e93d64c 100644 (file)
--- 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 a9c5501..80b80ee 100644 (file)
--- 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`