From: simonm <unknown>
Date: Mon, 22 Mar 1999 16:58:20 +0000 (+0000)
Subject: [project @ 1999-03-22 16:58:19 by simonm]
X-Git-Tag: Approximately_9120_patches~6362
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0d8fd5b2ab3e9f78af3d190ed6a6d7faa7c94e68;p=ghc-hetmet.git

[project @ 1999-03-22 16:58:19 by simonm]
Fix cost centres on PAPs.
---

diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index fbd57ad..56a4aeb 100644
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.25 1999/03/11 11:32:25 simonm Exp $
+% $Id: CgClosure.lhs,v 1.26 1999/03/22 16:58:19 simonm Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -457,14 +457,16 @@ enterCostCentreCode closure_info ccs is_thunk
 	    costCentresC SLIT("ENTER_CCS_FSUB") []
 
 	else if isCurrentCCS ccs then 
-	    -- get CCC out of the closure, where we put it when we alloc'd
-	    case is_thunk of 
-		IsThunk    -> costCentresC SLIT("ENTER_CCS_TCL") [CReg node]
-		IsFunction -> costCentresC SLIT("ENTER_CCS_FCL") [CReg node]
+	    if re_entrant 
+		then costCentresC SLIT("ENTER_CCS_FCL") [CReg node]
+		else costCentresC SLIT("ENTER_CCS_TCL") [CReg node]
 
 	else if isCafCCS ccs && isToplevClosure closure_info then
 	    ASSERT(is_thunk == IsThunk)
-	    costCentresC SLIT("ENTER_CCS_CAF") c_ccs
+		-- might be a PAP, in which case we want to subsume costs
+	    if re_entrant
+		then costCentresC SLIT("ENTER_CCS_FSUB") []
+		else costCentresC SLIT("ENTER_CCS_CAF") c_ccs
 
 	else -- we've got a "real" cost centre right here in our hands...
 	    case is_thunk of 
@@ -474,6 +476,7 @@ enterCostCentreCode closure_info ccs is_thunk
 			      else costCentresC SLIT("ENTER_CCS_FLOAD") c_ccs
    where
 	c_ccs = [mkCCostCentreStack ccs]
+	re_entrant = closureReEntrant closure_info
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 7a6ff6f..c81bafb 100644
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: ClosureInfo.lhs,v 1.35 1999/03/11 11:32:27 simonm Exp $
+% $Id: ClosureInfo.lhs,v 1.36 1999/03/22 16:58:20 simonm Exp $
 %
 \section[ClosureInfo]{Data structures which describe closures}
 
@@ -39,7 +39,7 @@ module ClosureInfo (
 	closureLabelFromCI,
 	entryLabelFromCI, 
 	closureLFInfo, closureSMRep, closureUpdReqd,
-	closureSingleEntry, closureSemiTag,
+	closureSingleEntry, closureReEntrant, closureSemiTag,
 	isStandardFormThunk,
 	GenStgArg,
 
@@ -891,7 +891,6 @@ closureLFInfo :: ClosureInfo -> LambdaFormInfo
 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
 
 closureUpdReqd :: ClosureInfo -> Bool
-
 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
 closureUpdReqd (MkClosureInfo _ LFBlackHole _)         = True
 	-- Black-hole closures are allocated to receive the results of an
@@ -899,14 +898,16 @@ closureUpdReqd (MkClosureInfo _ LFBlackHole _)         = True
 closureUpdReqd other_closure			       = False
 
 closureSingleEntry :: ClosureInfo -> Bool
-
 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
 closureSingleEntry other_closure			   = False
+
+closureReEntrant :: ClosureInfo -> Bool
+closureReEntrant (MkClosureInfo _ (LFReEntrant _ _ _ _ _ _) _) = True
+closureReEntrant other_closure = False
 \end{code}
 
 \begin{code}
 closureSemiTag :: ClosureInfo -> Maybe Int
-
 closureSemiTag (MkClosureInfo _ lf_info _)
   = case lf_info of
       LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)