%
% (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}
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
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}
closureLabelFromCI,
entryLabelFromCI,
closureLFInfo, closureSMRep, closureUpdReqd,
- closureSingleEntry, closureSemiTag,
+ closureSingleEntry, closureReEntrant, closureSemiTag,
isStandardFormThunk,
GenStgArg,
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
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)