From d01e768b927a536f36f8727f634a5e6e48e914e3 Mon Sep 17 00:00:00 2001 From: simonm Date: Fri, 23 Apr 1999 09:51:26 +0000 Subject: [PATCH] [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. --- ghc/compiler/codeGen/CgClosure.lhs | 7 +------ ghc/compiler/profiling/CostCentre.lhs | 20 ++++++-------------- ghc/compiler/profiling/SCCfinal.lhs | 5 +---- 3 files changed, 8 insertions(+), 24 deletions(-) diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index 6b5ad7b..0348f8f 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 1fa18cd..1d7e73b 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 3406858..d7a3a0d 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) -- 1.7.10.4