Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
0d8fd5b2
Commit
0d8fd5b2
authored
Mar 22, 1999
by
simonm
Browse files
[project @ 1999-03-22 16:58:19 by simonm]
Fix cost centres on PAPs.
parent
80cbfd10
Changes
2
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/codeGen/CgClosure.lhs
View file @
0d8fd5b2
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.2
5
1999/03/
11 11:32:25
simonm Exp $
% $Id: CgClosure.lhs,v 1.2
6
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}
%************************************************************************
...
...
ghc/compiler/codeGen/ClosureInfo.lhs
View file @
0d8fd5b2
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: ClosureInfo.lhs,v 1.3
5
1999/03/
11 11:32
:2
7
simonm Exp $
% $Id: ClosureInfo.lhs,v 1.3
6
1999/03/
22 16:58
:2
0
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)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment