Commit 0d8fd5b2 authored by simonm's avatar simonm
Browse files

[project @ 1999-03-22 16:58:19 by simonm]

Fix cost centres on PAPs.
parent 80cbfd10
%
% (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}
%************************************************************************
......
%
% (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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment