From 2c71b5dbed008d1d8752b722755143e797debb9d Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 2 Jan 2002 12:32:20 +0000 Subject: [PATCH] [project @ 2002-01-02 12:32:18 by simonmar] - Implement a small GC optimisation: when a static constructor has been determined to have no (indirect) CAF references, we set its static link field to a non-zero value (currently 1). This prevents the garbage collector from traversing this closure and transitively everything it points to, and thus should speed up GC a little. - Omit the static link field from static constructors which have no pointer fields (i.e. they are CONSTR_NOCAF_STATIC). - Add the padding words and the static link field for a static constructor at (AbsC) code generation time, rather than in the back ends. This eliminates some duplication between PprAbsC and AbsCStixGen. --- ghc/compiler/absCSyn/AbsCSyn.lhs | 9 +++-- ghc/compiler/absCSyn/AbsCUtils.lhs | 2 +- ghc/compiler/absCSyn/Costs.lhs | 4 +- ghc/compiler/absCSyn/PprAbsC.lhs | 26 ++++--------- ghc/compiler/codeGen/CgClosure.lhs | 28 ++++---------- ghc/compiler/codeGen/CgCon.lhs | 23 +++++------ ghc/compiler/codeGen/ClosureInfo.lhs | 66 +++++++++++++++++++++++++++----- ghc/compiler/nativeGen/AbsCStixGen.lhs | 35 ++++------------- 8 files changed, 101 insertions(+), 92 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 04e1367..91cf8c3 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (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} @@ -115,7 +115,7 @@ stored in a mixed type location.) | 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 @@ -192,8 +192,7 @@ stored in a mixed type location.) -- *** 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. @@ -375,6 +374,8 @@ data CAddrMode 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. diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index aeb8d30..b05c3c1 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -417,7 +417,7 @@ flatAbsC (CSequential abcs) -- 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) diff --git a/ghc/compiler/absCSyn/Costs.lhs b/ghc/compiler/absCSyn/Costs.lhs index 6ea0485..1730cc5 100644 --- a/ghc/compiler/absCSyn/Costs.lhs +++ b/ghc/compiler/absCSyn/Costs.lhs @@ -1,7 +1,7 @@ % % (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 % --------------------------------------------------------------------------- @@ -217,7 +217,7 @@ costs absC = CCallTypedef _ _ _ _ _ -> nullCosts - CStaticClosure _ _ _ _ -> nullCosts + CStaticClosure _ _ _ -> nullCosts CSRT _ _ -> nullCosts diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index d9dcea9..6ac1449 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -59,7 +59,7 @@ import StgSyn ( StgOp(..) ) import BitSet ( BitSet, intBS ) import Outputable import GlaExts -import Util ( nOfThem, lengthExceeds, listLengthCmp ) +import Util ( lengthExceeds, listLengthCmp ) import Maybe ( isNothing, maybeToList ) import ST @@ -442,8 +442,9 @@ pprAbsC (CInitHdr cl_info amode cost_centre size) _ 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, @@ -456,11 +457,12 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _ 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 <+> @@ -475,18 +477,6 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _ 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 [ @@ -1732,7 +1722,7 @@ ppr_decls_AbsC (CCallProfCtrMacro _ amodes) = ppr_decls_Amodes [] -- *****!!! -- 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 diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index 543c0a9..b3b447c 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.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} @@ -86,30 +86,18 @@ cgTopRhsClosure id ccs binder_info srt args body lf_info 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) diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs index 1e0fa93..6c97105 100644 --- a/ghc/compiler/codeGen/CgCon.lhs +++ b/ghc/compiler/codeGen/CgCon.lhs @@ -40,7 +40,7 @@ import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall, import CLabel ( mkClosureLabel ) import ClosureInfo ( mkConLFInfo, mkLFArgument, closureLFInfo, layOutDynConstr, layOutDynClosure, - layOutStaticConstr, closureSize + layOutStaticConstr, closureSize, mkStaticClosure ) import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack, currentCCS ) @@ -48,7 +48,8 @@ import DataCon ( DataCon, dataConName, dataConTag, 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 ) @@ -77,19 +78,19 @@ cgTopRhsCon id con args 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) diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index dcd2176..29d6037 100644 --- a/ghc/compiler/codeGen/ClosureInfo.lhs +++ b/ghc/compiler/codeGen/ClosureInfo.lhs @@ -1,7 +1,7 @@ % % (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} @@ -25,7 +25,7 @@ module ClosureInfo ( layOutDynClosure, layOutDynConstr, layOutStaticClosure, layOutStaticNoFVClosure, layOutStaticConstr, - mkVirtHeapOffsets, + mkVirtHeapOffsets, mkStaticClosure, nodeMustPointToIt, getEntryConvention, FCode, CgInfoDownwards, CgState, @@ -56,7 +56,7 @@ module ClosureInfo ( #include "HsVersions.h" -import AbsCSyn ( MagicId, node, VirtualHeapOffset, HeapOffset, C_SRT(..), needsSRT ) +import AbsCSyn import StgSyn import CgMonad @@ -418,6 +418,46 @@ layOutStaticNoFVClosure name lf_info srt_info 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} %************************************************************************ @@ -730,19 +770,27 @@ staticClosureNeedsLink :: ClosureInfo -> Bool -- 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 diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs index 2445f57..888d129 100644 --- a/ghc/compiler/nativeGen/AbsCStixGen.lhs +++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs @@ -26,8 +26,7 @@ import CLabel ( CLabel, mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel, mkClosureLabel, labelDynamic, mkSplitMarkerLabel ) import ClosureInfo ( infoTableLabelFromCI, entryLabelFromCI, - fastLabelFromCI, closureUpdReqd, - staticClosureNeedsLink + closureLabelFromCI, fastLabelFromCI ) import Literal ( Literal(..), word2IntLit ) import Maybes ( maybeToBool ) @@ -89,7 +88,7 @@ Here we handle top-level things, like @CCodeBlock@s and = 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 @@ -99,6 +98,8 @@ Here we handle top-level things, like @CCodeBlock@s and : 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 -> @@ -110,8 +111,8 @@ Here we handle top-level things, like @CCodeBlock@s and -- 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) @@ -226,12 +227,11 @@ Here we handle top-level things, like @CCodeBlock@s and :: 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] @@ -240,25 +240,6 @@ Here we handle top-level things, like @CCodeBlock@s and 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. -- 1.7.10.4