%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: AbsCSyn.lhs,v 1.43 2001/12/14 15:26:14 sewardj Exp $
+% $Id: AbsCSyn.lhs,v 1.44 2002/01/02 12:32:19 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
| CInitHdr -- to initialise the header of a closure (both fixed/var parts)
ClosureInfo
CAddrMode -- address of the info ptr
- CAddrMode -- cost centre to place in closure
+ !CAddrMode -- cost centre to place in closure
-- CReg CurCostCentre or CC_HDR(R1.p{-Node-})
Int -- size of closure, for profiling
-- *** the next three [or so...] are DATA (those above are CODE) ***
| CStaticClosure
- CLabel -- The (full, not base) label to use for labelling the closure.
- ClosureInfo
+ ClosureInfo -- Todo: maybe info_lbl & closure_lbl instead?
CAddrMode -- cost centre identifier to place in closure
[CAddrMode] -- free vars; ptrs, then non-ptrs.
CAddrMode -- specified address
| CBytesPerWord -- Word size, in bytes, on this platform
+ -- required for: half-word loads (used in fishing tags
+ -- out of info tables), and sizeofByteArray#.
\end{code}
Various C macros for values which are dependent on the back-end layout.
-- Some statements only make sense at the top level, so we always float
-- them. This probably isn't necessary.
-flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CStaticClosure _ _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CBitmap _ _) = returnFlt (AbsCNop, stmt)
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: Costs.lhs,v 1.30 2001/11/23 11:58:00 simonmar Exp $
+% $Id: Costs.lhs,v 1.31 2002/01/02 12:32:19 simonmar Exp $
%
% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------
CCallTypedef _ _ _ _ _ -> nullCosts
- CStaticClosure _ _ _ _ -> nullCosts
+ CStaticClosure _ _ _ -> nullCosts
CSRT _ _ -> nullCosts
import BitSet ( BitSet, intBS )
import Outputable
import GlaExts
-import Util ( nOfThem, lengthExceeds, listLengthCmp )
+import Util ( lengthExceeds, listLengthCmp )
import Maybe ( isNothing, maybeToList )
import ST
pp_paren_semi ]
where
info_lbl = infoTableLabelFromCI cl_info
-
-pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
+
+
+pprAbsC stmt@(CStaticClosure cl_info cost_centre amodes) _
= case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
vcat [
pp_exts,
ppLocalnessMacro True{-include dyn-} info_lbl,
char ')'
],
- nest 2 (ppr_payload (amodes ++ padding_wds ++ static_link_field)),
+ nest 2 (ppr_payload amodes),
ptext SLIT("};") ]
}
where
- info_lbl = infoTableLabelFromCI cl_info
+ closure_lbl = closureLabelFromCI cl_info
+ info_lbl = infoTableLabelFromCI cl_info
ppr_payload [] = empty
ppr_payload ls = comma <+>
where
rep = getAmodeRep item
- upd_reqd = closureUpdReqd cl_info
-
- padding_wds
- | not upd_reqd = []
- | otherwise = case max 0 (mIN_UPD_SIZE - length amodes) of { still_needed ->
- nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
-
- -- always have a static link field, it's used to save the closure's
- -- info pointer when we're reverting CAFs (see comment in Storage.c)
- static_link_field
- | upd_reqd || staticClosureNeedsLink cl_info = [mkIntCLit 0]
- | otherwise = []
pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _
= vcat [
-- no real reason to, anyway.
ppr_decls_AbsC (CCallProfCCMacro _ amodes) = ppr_decls_Amodes amodes
-ppr_decls_AbsC (CStaticClosure closure_lbl closure_info cost_centre amodes)
+ppr_decls_AbsC (CStaticClosure closure_info cost_centre amodes)
-- ToDo: strictly speaking, should chk "cost_centre" amode
= ppr_decls_Amodes amodes
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgClosure.lhs,v 1.53 2001/11/23 11:47:12 simonmar Exp $
+% $Id: CgClosure.lhs,v 1.54 2002/01/02 12:32:18 simonmar Exp $
%
\section[CgClosure]{Code generation for closures}
let
name = idName id
closure_info = layOutStaticNoFVClosure name lf_info srt_info
- closure_label = mkClosureLabel name
+ closure_label = mkClosureLabel name
cg_id_info = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
in
-- BUILD THE OBJECT (IF NECESSARY)
- ({- if staticClosureRequired name binder_info lf_info
- then -}
- (if opt_SccProfilingOn
- then
- absC (CStaticClosure
- closure_label -- Labelled with the name on lhs of defn
- closure_info
- (mkCCostCentreStack ccs)
- []) -- No fields
- else
- absC (CStaticClosure
- closure_label -- Labelled with the name on lhs of defn
- closure_info
- (panic "absent cc")
- []) -- No fields
- )
-
- {- else
+ (
+ ({- if staticClosureRequired name binder_info lf_info
+ then -}
+ absC (mkStaticClosure closure_info ccs [] True)
+ {- else
nopC -}
+ )
`thenC`
-- GENERATE THE INFO TABLE (IF NECESSARY)
import CLabel ( mkClosureLabel )
import ClosureInfo ( mkConLFInfo, mkLFArgument, closureLFInfo,
layOutDynConstr, layOutDynClosure,
- layOutStaticConstr, closureSize
+ layOutStaticConstr, closureSize, mkStaticClosure
)
import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
currentCCS )
isUnboxedTupleCon, isNullaryDataCon, dataConId,
dataConWrapId, dataConRepArity
)
-import Id ( Id, idName, idPrimRep )
+import Id ( Id, idName, idPrimRep, idCafInfo )
+import IdInfo ( mayHaveCafRefs )
import Literal ( Literal(..) )
import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
import PrimRep ( PrimRep(..), isFollowableRep )
let
name = idName id
- closure_label = mkClosureLabel name
lf_info = closureLFInfo closure_info
- (closure_info, amodes_w_offsets) = layOutStaticConstr name con getAmodeRep amodes
+ closure_label = mkClosureLabel name
+ (closure_info, amodes_w_offsets)
+ = layOutStaticConstr name con getAmodeRep amodes
in
-- BUILD THE OBJECT
- absC (CStaticClosure
- closure_label -- Labelled with the name on lhs of defn
- closure_info -- Closure is static
- (mkCCostCentreStack dontCareCCS) -- because it's static data
- (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
-
- `thenC`
+ absC (mkStaticClosure
+ closure_info
+ dontCareCCS -- because it's static data
+ (map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs
+ (mayHaveCafRefs (idCafInfo id))
+ ) `thenC`
-- RETURN
returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: ClosureInfo.lhs,v 1.50 2001/10/25 02:13:11 sof Exp $
+% $Id: ClosureInfo.lhs,v 1.51 2002/01/02 12:32:19 simonmar Exp $
%
\section[ClosureInfo]{Data structures which describe closures}
layOutDynClosure, layOutDynConstr, layOutStaticClosure,
layOutStaticNoFVClosure, layOutStaticConstr,
- mkVirtHeapOffsets,
+ mkVirtHeapOffsets, mkStaticClosure,
nodeMustPointToIt, getEntryConvention,
FCode, CgInfoDownwards, CgState,
#include "HsVersions.h"
-import AbsCSyn ( MagicId, node, VirtualHeapOffset, HeapOffset, C_SRT(..), needsSRT )
+import AbsCSyn
import StgSyn
import CgMonad
where
rep = GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info)
is_static = True
+
+
+-- make a static closure, adding on any extra padding needed for CAFs,
+-- and adding a static link field if necessary.
+
+mkStaticClosure closure_info ccs fields cafrefs
+ | opt_SccProfilingOn =
+ CStaticClosure
+ closure_info
+ (mkCCostCentreStack ccs)
+ all_fields
+ | otherwise =
+ CStaticClosure
+ closure_info
+ (panic "absent cc")
+ all_fields
+
+ where
+ all_fields = fields ++ padding_wds ++ static_link_field
+
+ upd_reqd = closureUpdReqd closure_info
+
+ padding_wds
+ | not upd_reqd = []
+ | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
+ where n = max 0 (mIN_UPD_SIZE - length fields)
+
+ -- We always have a static link field for a thunk, it's used to
+ -- save the closure's info pointer when we're reverting CAFs
+ -- (see comment in Storage.c)
+ static_link_field
+ | upd_reqd || staticClosureNeedsLink closure_info = [static_link_value]
+ | otherwise = []
+
+ -- for a static constructor which has NoCafRefs, we set the
+ -- static link field to a non-zero value so the garbage
+ -- collector will ignore it.
+ static_link_value
+ | cafrefs = mkIntCLit 0
+ | otherwise = mkIntCLit 1
\end{code}
%************************************************************************
-- A static closure needs a link field to aid the GC when traversing
-- the static closure graph. But it only needs such a field if either
-- a) it has an SRT
--- b) it's a non-nullary constructor
+-- b) it's a constructor with one or more pointer fields
-- In case (b), the constructor's fields themselves play the role
-- of the SRT.
-staticClosureNeedsLink (MkClosureInfo { closureName = name, closureSRT = srt, closureLFInfo = info })
- = needsSRT srt || constructor_srt
+staticClosureNeedsLink (MkClosureInfo { closureName = name,
+ closureSRT = srt,
+ closureLFInfo = lf_info,
+ closureSMRep = sm_rep })
+ = needsSRT srt || (constr_with_fields && not_nocaf_constr)
where
- constructor_srt
- = case info of
+ not_nocaf_constr =
+ case sm_rep of
+ GenericRep _ _ _ CONSTR_NOCAF -> False
+ _other -> True
+
+ constr_with_fields =
+ case lf_info of
LFThunk _ _ _ _ _ -> False
LFReEntrant _ _ _ _ -> False
LFCon _ is_nullary -> not is_nullary
LFTuple _ is_nullary -> not is_nullary
- other -> pprPanic "staticClosureNeedsLink" (ppr name)
+ _other -> pprPanic "staticClosureNeedsLink" (ppr name)
\end{code}
Avoiding generating entries and info tables
mkClosureTblLabel, mkClosureLabel,
labelDynamic, mkSplitMarkerLabel )
import ClosureInfo ( infoTableLabelFromCI, entryLabelFromCI,
- fastLabelFromCI, closureUpdReqd,
- staticClosureNeedsLink
+ closureLabelFromCI, fastLabelFromCI
)
import Literal ( Literal(..), word2IntLit )
import Maybes ( maybeToBool )
= gencode absC `thenUs` \ code ->
returnUs (StSegment TextSegment : StFunBegin lbl : code [StFunEnd lbl])
- gentopcode stmt@(CStaticClosure lbl _ _ _)
+ gentopcode stmt@(CStaticClosure closure_info _ _)
= genCodeStaticClosure stmt `thenUs` \ code ->
returnUs (
if opt_Static
: StData PtrRep [StInt 0] -- DLLised world, need extra zero word
: StLabel lbl : code []
)
+ where
+ lbl = closureLabelFromCI closure_info
gentopcode stmt@(CRetVector lbl _ _ _)
= genCodeVecTbl stmt `thenUs` \ code ->
-- for ensuring the GC works correctly, although GC crashes due to
-- misclassification are much more likely to show up in the interactive
-- system than in compile code. For details see comment near line 1164
- -- of ghc/driver/mangler/ghc-asm.lprl, which contains an analogous fix for
- -- the mangled via-C route.
+ -- of ghc/driver/mangler/ghc-asm.lprl, which contains an analogous fix
+ -- for the mangled via-C route.
vtbl_post_label_word = StData PtrRep [StInt 0]
gentopcode stmt@(CRetDirect uniq absC srt liveness)
:: AbstractC
-> UniqSM StixTreeList
-}
- genCodeStaticClosure (CStaticClosure _ cl_info cost_centre amodes)
+ genCodeStaticClosure (CStaticClosure cl_info cost_centre amodes)
= returnUs (\xs -> table ++ xs)
where
table = StData PtrRep [StCLbl (infoTableLabelFromCI cl_info)] :
- map do_one_amode amodes ++
- [StData PtrRep (padding_wds ++ static_link)]
+ map do_one_amode amodes
do_one_amode amode
= StData (promote_to_word (getAmodeRep amode)) [a2stix amode]
promote_to_word pk
| getPrimRepArrayElemSize pk >= getPrimRepArrayElemSize IntRep = pk
| otherwise = IntRep
-
- upd_reqd = closureUpdReqd cl_info
-
- padding_wds
- | upd_reqd = take (max 0 (mIN_UPD_SIZE - length amodes)) zeros
- | otherwise = []
-
- static_link | upd_reqd || staticClosureNeedsLink cl_info = [StInt 0]
- | otherwise = []
-
- zeros = StInt 0 : zeros
-
- {- needed??? --SDM
- -- Watch out for VoidKinds...cf. PprAbsC
- amodeZeroVoid item
- | getAmodeRep item == VoidRep = StInt 0
- | otherwise = a2stix item
- -}
-
\end{code}
Now the individual AbstractC statements.
projects / ghc-hetmet.git / commitdiff