summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonm <unknown>1999-04-23 09:51:26 +0000
committersimonm <unknown>1999-04-23 09:51:26 +0000
commitd01e768b927a536f36f8727f634a5e6e48e914e3 (patch)
treed39657faff9702f3aa7ef9d205e672546325da8c
parentcb1ce9cd75baa5e640ec795c1518eb537b1caa28 (diff)
downloadhaskell-d01e768b927a536f36f8727f634a5e6e48e914e3.tar.gz
[project @ 1999-04-23 09:51:24 by simonm]
Remove hack to force setting the CCCS when we enter a function closure defined inside a lambda. We use a more general solution now.
-rw-r--r--ghc/compiler/codeGen/CgClosure.lhs7
-rw-r--r--ghc/compiler/profiling/CostCentre.lhs20
-rw-r--r--ghc/compiler/profiling/SCCfinal.lhs5
3 files changed, 8 insertions, 24 deletions
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 6b5ad7bc3f..0348f8f282 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.27 1999/04/08 15:46:15 simonm Exp $
+% $Id: CgClosure.lhs,v 1.28 1999/04/23 09:51:24 simonm Exp $
%
\section[CgClosure]{Code generation for closures}
@@ -459,11 +459,6 @@ enterCostCentreCode closure_info ccs is_thunk is_box
ASSERT(is_thunk == IsFunction)
costCentresC SLIT("ENTER_CCS_FSUB") []
- else if isSetCurrentCCS ccs then
- ASSERT(not (isToplevClosure closure_info))
- ASSERT(is_thunk == IsFunction)
- costCentresC SLIT("ENTER_CCS_TCL") [CReg node]
-
else if isCurrentCCS ccs then
if re_entrant && not is_box
then costCentresC SLIT("ENTER_CCS_FCL") [CReg node]
diff --git a/ghc/compiler/profiling/CostCentre.lhs b/ghc/compiler/profiling/CostCentre.lhs
index 1fa18cd27a..1d7e73bc72 100644
--- a/ghc/compiler/profiling/CostCentre.lhs
+++ b/ghc/compiler/profiling/CostCentre.lhs
@@ -9,9 +9,9 @@ module CostCentre (
-- All abstract except to friend: ParseIface.y
CostCentreStack,
- noCCS, subsumedCCS, currentCCS, setCurrentCCS, overheadCCS, dontCareCCS,
+ noCCS, subsumedCCS, currentCCS, overheadCCS, dontCareCCS,
noCostCentre, noCCAttached,
- noCCSAttached, isCurrentCCS, isSetCurrentCCS, isSubsumedCCS, currentOrSubsumedCCS,
+ noCCSAttached, isCurrentCCS, isSubsumedCCS, currentOrSubsumedCCS,
mkUserCC, mkAutoCC, mkAllCafsCC,
mkSingletonCCS, cafifyCC, dupifyCC,
@@ -53,10 +53,6 @@ data CostCentreStack
-- is allocated, is whatever is in the
-- current-cost-centre-stack register.
- | SetCurrentCCS -- Special cost centre for non-top-level functions
- -- which is always *set* rather than possibly
- -- appended to the current CCS.
-
| SubsumedCCS -- Cost centre stack for top-level subsumed functions
-- (CAFs get an AllCafsCC).
-- Its execution costs get subsumed into the caller.
@@ -155,7 +151,6 @@ SIMON: Maybe later...
noCCS = NoCCS
subsumedCCS = SubsumedCCS
currentCCS = CurrentCCS
-setCurrentCCS = SetCurrentCCS
overheadCCS = OverheadCCS
dontCareCCS = DontCareCCS
@@ -174,9 +169,6 @@ noCCAttached _ = False
isCurrentCCS CurrentCCS = True
isCurrentCCS _ = False
-isSetCurrentCCS SetCurrentCCS = True
-isSetCurrentCCS _ = False
-
isSubsumedCCS SubsumedCCS = True
isSubsumedCCS _ = False
@@ -185,7 +177,6 @@ isCafCCS _ = False
currentOrSubsumedCCS SubsumedCCS = True
currentOrSubsumedCCS CurrentCCS = True
-currentOrSubsumedCCS SetCurrentCCS = True
currentOrSubsumedCCS _ = False
\end{code}
@@ -306,7 +297,6 @@ instance Outputable CostCentreStack where
ppr ccs = case ccs of
NoCCS -> ptext SLIT("NO_CCS")
CurrentCCS -> ptext SLIT("CCCS")
- SetCurrentCCS -> ptext SLIT("SetCCCS")
OverheadCCS -> ptext SLIT("CCS_OVERHEAD")
DontCareCCS -> ptext SLIT("CCS_DONTZuCARE")
SubsumedCCS -> ptext SLIT("CCS_SUBSUMED")
@@ -373,13 +363,15 @@ pp_caf other = empty
-- Printing as a C label
ppCostCentreLbl (NoCostCentre) = text "CC_NONE"
ppCostCentreLbl (AllCafsCC {cc_mod = m}) = text "CC_CAFs_" <> pprModule m
-ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m}) = text "CC_" <> pprModule m <> ptext n
+ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = is_caf})
+ = text "CC_" <> text (case is_caf of { CafCC -> "CAF_"; _ -> "" })
+ <> pprModule m <> ptext n
-- This is the name to go in the user-displayed string,
-- recorded in the cost centre declaration
costCentreUserName (NoCostCentre) = "NO_CC"
costCentreUserName (AllCafsCC {}) = "CAFs_in_..."
-costCentreUserName (NormalCC {cc_name = name, cc_is_caf = is_caf})
+costCentreUserName cc@(NormalCC {cc_name = name, cc_is_caf = is_caf})
= case is_caf of { CafCC -> "CAF:"; _ -> "" } ++ decode (_UNPK_ name)
\end{code}
diff --git a/ghc/compiler/profiling/SCCfinal.lhs b/ghc/compiler/profiling/SCCfinal.lhs
index 3406858cce..d7a3a0d890 100644
--- a/ghc/compiler/profiling/SCCfinal.lhs
+++ b/ghc/compiler/profiling/SCCfinal.lhs
@@ -269,10 +269,7 @@ stgMassageForProfiling mod_name grp_name us stg_binds
do_rhs (StgRhsClosure cc bi srt fv u args body)
= set_lambda_cc (do_expr body) `thenMM` \ body' ->
get_prevailing_cc `thenMM` \ prev_ccs ->
- let new_ccs | isCurrentCCS prev_ccs = setCurrentCCS -- are we inside a lambda??
- | otherwise = currentCCS
- in
- returnMM (StgRhsClosure new_ccs bi srt fv u args body')
+ returnMM (StgRhsClosure currentCCS bi srt fv u args body')
do_rhs (StgRhsCon cc con args)
= returnMM (StgRhsCon currentCCS con args)