diff options
| -rw-r--r-- | compiler/cmm/SMRep.lhs | 6 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmm.hs | 1 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 22 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmClosure.hs | 94 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 7 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 21 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 6 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmTicky.hs | 24 |
8 files changed, 74 insertions, 107 deletions
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index bc502a30a3..44b40a3a8a 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -25,7 +25,7 @@ module SMRep ( mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep, -- ** Predicates - isStaticRep, isConRep, isThunkRep, isStaticNoCafCon, + isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon, -- ** Size-related things heapClosureSize, @@ -196,6 +196,10 @@ isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True isThunkRep (HeapRep _ _ _ BlackHole{}) = True isThunkRep _ = False +isFunRep :: SMRep -> Bool +isFunRep (HeapRep _ _ _ Fun{}) = True +isFunRep _ = False + isStaticNoCafCon :: SMRep -> Bool -- This should line up exactly with CONSTR_NOCAF_STATIC above -- See Note [Static NoCaf constructors] diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index f88541a023..0928645964 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -24,7 +24,6 @@ import StgCmmTicky import Cmm import CLabel -import PprCmm import StgSyn import DynFlags diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index e8874fa752..84b33ef29b 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -298,7 +298,8 @@ mkRhsClosure bndr cc _ fvs upd_flag srt args body ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body ; emit (mkComment $ mkFastString "calling allocDynClosure") ; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off) - ; (tmp, init) <- allocDynClosure closure_info use_cc blame_cc + ; let info_tbl = mkCmmInfo closure_info + ; (tmp, init) <- allocDynClosure info_tbl lf_info use_cc blame_cc (map toVarArg fv_details) -- RETURN @@ -334,7 +335,9 @@ cgStdThunk bndr cc _bndr_info body lf_info payload ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body -- BUILD THE OBJECT - ; (tmp, init) <- allocDynClosure closure_info use_cc blame_cc payload_w_offsets + ; let info_tbl = mkCmmInfo closure_info + ; (tmp, init) <- allocDynClosure info_tbl lf_info + use_cc blame_cc payload_w_offsets -- RETURN ; regIdInfo bndr lf_info tmp init } @@ -555,7 +558,7 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: - { upd_closure <- link_caf closure_info True + { upd_closure <- link_caf True ; pushUpdateFrame [CmmReg (CmmLocal upd_closure), mkLblExpr mkUpdInfoLabel] body } -- XXX black hole else do {tickyUpdateFrameOmitted; body} @@ -611,8 +614,7 @@ pushUpdateFrame es body -- be closer together, and the compiler wouldn't need to know -- about off_indirectee etc. -link_caf :: ClosureInfo - -> Bool -- True <=> updatable, False <=> single-entry +link_caf :: Bool -- True <=> updatable, False <=> single-entry -> FCode LocalReg -- Returns amode for closure to be updated -- To update a CAF we must allocate a black hole, link the CAF onto the -- CAF list, then update the CAF to point to the fresh black hole. @@ -620,13 +622,14 @@ link_caf :: ClosureInfo -- updated with the new value when available. The reason for all of this -- is that we only want to update dynamic heap objects, not static ones, -- so that generational GC is easier. -link_caf cl_info _is_upd = do +link_caf _is_upd = do { -- Alloc black hole specifying CC_HDR(Node) as the cost centre ; let use_cc = costCentreFrom (CmmReg nodeReg) blame_cc = use_cc tso = CmmReg (CmmGlobal CurrentTSO) - -- XXX ezyang: FIXME - ; (hp_rel, init) <- allocDynClosureCmm bh_cl_info use_cc blame_cc [(tso,fixedHdrSize)] + + ; (hp_rel, init) <- allocDynClosureCmm cafBlackHoleInfoTable mkLFBlackHole + use_cc blame_cc [(tso,fixedHdrSize)] ; emit init -- Call the RTS function newCAF to add the CAF to the CafList @@ -646,9 +649,6 @@ link_caf cl_info _is_upd = do ; return hp_rel } where - bh_cl_info :: ClosureInfo - bh_cl_info = cafBlackHoleClosureInfo cl_info - ind_static_info :: CmmExpr ind_static_info = mkLblExpr mkIndStaticInfoLabel diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 58eb427f22..64e3e2b90f 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -27,12 +27,13 @@ module StgCmmClosure ( StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, - lfDynTag, - maybeIsLFCon, isLFThunk, isLFReEntrant, + mkLFBlackHole, + lfDynTag, + maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable, ----------------------------------- ClosureInfo, - mkClosureInfo, mkConInfo, + mkClosureInfo, mkCmmInfo, closureSize, @@ -40,7 +41,7 @@ module StgCmmClosure ( closureLabelFromCI, closureProf, closureSRT, closureLFInfo, closureSMRep, closureUpdReqd, closureIsThunk, - closureSingleEntry, closureReEntrant, isConstrClosure_maybe, + closureSingleEntry, closureReEntrant, closureFunInfo, isStandardFormThunk, isKnownFun, funTag, tagForArity, @@ -53,11 +54,11 @@ module StgCmmClosure ( isToplevClosure, isStaticClosure, - cafBlackHoleClosureInfo, - staticClosureNeedsLink, clHasCafRefs, clProfInfo, + staticClosureNeedsLink, clHasCafRefs, mkDataConInfoTable, + cafBlackHoleInfoTable ) where #include "../includes/MachDeps.h" @@ -152,6 +153,9 @@ data LambdaFormInfo -- of a CAF. We want the target of the update frame to -- be in the heap, so we make a black hole to hold it. + -- XXX we can very nearly get rid of this, but + -- allocDynClosure needs a LambdaFormInfo + ------------------------- -- An ArgDsecr describes the argument pattern of a function @@ -286,6 +290,10 @@ mkLFImported id where arity = idArity id +------------ +mkLFBlackHole :: LambdaFormInfo +mkLFBlackHole = LFBlackHole + ----------------------------------------------------- -- Dynamic pointer tagging ----------------------------------------------------- @@ -648,10 +656,8 @@ enough information b) to allocate a closure containing that info pointer (i.e. it knows the info table label) -We make a ClosureInfo for - - each let binding (both top level and not) - - each data constructor (for its shared static and - dynamic info tables) +We make a ClosureInfo for each let binding (both top level and not), +but not bindings for data constructors. Note [Closure CAF info] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -674,22 +680,10 @@ data ClosureInfo closureInfLcl :: Bool -- Can the info pointer be a local symbol? } - -- Constructor closures don't have a unique info table label (they use - -- the constructor's info table), and they don't have an SRT. - | ConInfo { - closureCon :: !DataCon, - closureSMRep :: !SMRep, - closureCafs :: !CafInfo -- See Note [Closure CAF info] - } - clHasCafRefs :: ClosureInfo -> CafInfo -- Backward compatibility; remove clHasCafRefs = closureCafs -clProfInfo :: ClosureInfo -> ProfilingInfo -clProfInfo ClosureInfo{ closureProf = p } = p -clProfInfo _ = NoProfilingInfo - -------------------------------------- -- Building ClosureInfos -------------------------------------- @@ -719,32 +713,6 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr prof = mkProfilingInfo id val_descr nonptr_wds = tot_wds - ptr_wds -mkConInfo :: Bool -- Is static - -> CafInfo - -> DataCon - -> Int -> Int -- Total and pointer words - -> ClosureInfo -mkConInfo is_static cafs data_con tot_wds ptr_wds - = ConInfo { closureSMRep = sm_rep - , closureCafs = cafs - , closureCon = data_con } - where - sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info) - lf_info = mkConLFInfo data_con - nonptr_wds = tot_wds - ptr_wds - --- We need a black-hole closure info to pass to @allocDynClosure@ when we --- want to allocate the black hole on entry to a CAF. These are the only --- ways to build an LFBlackHole, maintaining the invariant that it really --- is a black hole and not something else. - -cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo -cafBlackHoleClosureInfo cl_info@(ClosureInfo {}) - = cl_info { closureLFInfo = LFBlackHole - , closureSMRep = blackHoleRep - , closureSRT = NoC_SRT - , closureInfLcl = False } -cafBlackHoleClosureInfo (ConInfo {}) = panic "cafBlackHoleClosureInfo" -- Convert from 'ClosureInfo' to 'CmmInfoTable'. -- Not used for return points. @@ -752,7 +720,7 @@ mkCmmInfo :: ClosureInfo -> CmmInfoTable mkCmmInfo cl_info = CmmInfoTable { cit_lbl = infoTableLabelFromCI cl_info, cit_rep = closureSMRep cl_info, - cit_prof = clProfInfo cl_info, + cit_prof = closureProf cl_info, cit_srt = closureSRT cl_info } @@ -774,7 +742,6 @@ blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool -- Single-entry ones have no fvs to plug, and we trust they don't form part -- of a loop. -blackHoleOnEntry _ ConInfo{} = False blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) | isStaticRep rep = False -- Never black-hole a static closure @@ -797,7 +764,6 @@ isStaticClosure cl_info = isStaticRep (closureSMRep cl_info) closureUpdReqd :: ClosureInfo -> Bool closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info -closureUpdReqd ConInfo{} = False lfUpdatable :: LambdaFormInfo -> Bool lfUpdatable (LFThunk _ _ upd _ _) = upd @@ -808,7 +774,6 @@ lfUpdatable _ = False closureIsThunk :: ClosureInfo -> Bool closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info -closureIsThunk ConInfo{} = False closureSingleEntry :: ClosureInfo -> Bool closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd @@ -818,13 +783,8 @@ closureReEntrant :: ClosureInfo -> Bool closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True closureReEntrant _ = False -isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon -isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con -isConstrClosure_maybe _ = Nothing - closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr) closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info -closureFunInfo _ = Nothing lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr) lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc) @@ -832,7 +792,6 @@ lfFunInfo _ = Nothing funTag :: ClosureInfo -> DynTag funTag (ClosureInfo { closureLFInfo = lf_info }) = lfDynTag lf_info -funTag (ConInfo {}) = panic "funTag" isToplevClosure :: ClosureInfo -> Bool isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) @@ -840,7 +799,6 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) LFReEntrant TopLevel _ _ _ -> True LFThunk TopLevel _ _ _ _ -> True _other -> False -isToplevClosure _ = False -------------------------------------- -- Label generation @@ -871,14 +829,6 @@ infoTableLabelFromCI (ClosureInfo { closureName = name, std_mk_lbl | is_lcl = mkLocalInfoTableLabel | otherwise = mkInfoTableLabel -infoTableLabelFromCI (ConInfo { closureCon = con, - closureSMRep = rep, - closureCafs = cafs }) - | isStaticRep rep = mkStaticInfoTableLabel name cafs - | otherwise = mkConInfoTableLabel name cafs - where - name = dataConName con - -- ClosureInfo for a closure (as opposed to a constructor) is always local closureLabelFromCI :: ClosureInfo -> CLabel closureLabelFromCI cl@(ClosureInfo { closureName = nm }) = @@ -984,6 +934,15 @@ mkDataConInfoTable data_con is_static ptr_wds nonptr_wds ty_descr = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con val_descr = stringToWord8s $ occNameString $ getOccName data_con +-- We need a black-hole closure info to pass to @allocDynClosure@ when we +-- want to allocate the black hole on entry to a CAF. + +cafBlackHoleInfoTable :: CmmInfoTable +cafBlackHoleInfoTable + = CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel + , cit_rep = blackHoleRep + , cit_prof = NoProfilingInfo + , cit_srt = NoC_SRT } staticClosureNeedsLink :: CmmInfoTable -> Bool -- A static closure needs a link field to aid the GC when traversing @@ -996,3 +955,4 @@ staticClosureNeedsLink info_tbl@CmmInfoTable{ cit_rep = smrep } | isConRep smrep = not (isStaticNoCafCon smrep) | otherwise = needsSRT (cit_srt info_tbl) staticClosureNeedsLink _ = False + diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index ee7b0be6f2..dd3c68e26e 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -34,7 +34,6 @@ import Module import Constants import DataCon import FastString -import IdInfo( CafInfo(..) ) import Id import Literal import PrelInfo @@ -202,8 +201,10 @@ buildDynCon binder ccs con args = do { let (tot_wds, ptr_wds, args_w_offsets) = mkVirtConstrOffsets (addArgReps args) -- No void args in args_w_offsets - cl_info = mkConInfo False NoCafRefs con tot_wds ptr_wds - ; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets + nonptr_wds = tot_wds - ptr_wds + info_tbl = mkDataConInfoTable con False ptr_wds nonptr_wds + ; (tmp, init) <- allocDynClosure info_tbl lf_info + use_cc blame_cc args_w_offsets ; regIdInfo binder lf_info tmp init } where lf_info = mkConLFInfo con diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index d094337ef5..ec0dd05a8e 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -49,7 +49,8 @@ import Constants ----------------------------------------------------------- allocDynClosure - :: ClosureInfo + :: CmmInfoTable + -> LambdaFormInfo -> CmmExpr -- Cost Centre to stick in the object -> CmmExpr -- Cost Centre to blame for this alloc -- (usually the same; sometimes "OVERHEAD") @@ -60,7 +61,7 @@ allocDynClosure -> FCode (LocalReg, CmmAGraph) allocDynClosureCmm - :: ClosureInfo -> CmmExpr -> CmmExpr + :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr -> [(CmmExpr, VirtualHpOffset)] -> FCode (LocalReg, CmmAGraph) @@ -81,18 +82,20 @@ allocDynClosureCmm -- but Hp+8 means something quite different... -allocDynClosure cl_info use_cc _blame_cc args_w_offsets +allocDynClosure info_tbl lf_info use_cc _blame_cc args_w_offsets = do { let (args, offsets) = unzip args_w_offsets ; cmm_args <- mapM getArgAmode args -- No void args - ; allocDynClosureCmm cl_info use_cc _blame_cc (zip cmm_args offsets) + ; allocDynClosureCmm info_tbl lf_info + use_cc _blame_cc (zip cmm_args offsets) } -allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets +allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets = do { virt_hp <- getVirtHp -- SAY WHAT WE ARE ABOUT TO DO - ; tickyDynAlloc cl_info - ; profDynAlloc cl_info use_cc + ; let rep = cit_rep info_tbl + ; tickyDynAlloc rep lf_info + ; profDynAlloc rep use_cc -- ToDo: This is almost certainly wrong -- We're ignoring blame_cc. But until we've -- fixed the boxing hack in chooseDynCostCentres etc, @@ -106,7 +109,7 @@ allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets -- Remember, virtHp points to last allocated word, -- ie 1 *before* the info-ptr word of new object. - info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info)) + info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl)) -- ALLOCATE THE OBJECT ; base <- getHpRelOffset info_offset @@ -116,7 +119,7 @@ allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets ; hpStore base cmm_args offsets -- BUMP THE VIRTUAL HEAP POINTER - ; setVirtHp (virt_hp + closureSize cl_info) + ; setVirtHp (virt_hp + heapClosureSize rep) -- Assign to a temporary and return -- Note [Return a LocalReg] diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index ca116f2218..b1aca6e37e 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -156,10 +156,10 @@ restoreCurrentCostCentre (Just local_cc) -- | Record the allocation of a closure. The CmmExpr is the cost -- centre stack to which to attribute the allocation. -profDynAlloc :: ClosureInfo -> CmmExpr -> FCode () -profDynAlloc cl_info ccs +profDynAlloc :: SMRep -> CmmExpr -> FCode () +profDynAlloc rep ccs = ifProfiling $ - profAlloc (CmmLit (mkIntCLit (closureSize cl_info))) ccs + profAlloc (CmmLit (mkIntCLit (heapClosureSize rep))) ccs -- | Record the allocation of a closure (size is given by a CmmExpr) -- The size must be in words, because the allocation counter in a CCS counts diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 3775130aaf..2da539b1e9 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -51,6 +51,7 @@ import CmmExpr import MkGraph import CmmUtils import CLabel +import SMRep import Module import Name @@ -266,25 +267,24 @@ argChar DoubleArg = 'd' -- ----------------------------------------------------------------------------- -- Ticky allocation -tickyDynAlloc :: ClosureInfo -> FCode () +tickyDynAlloc :: SMRep -> LambdaFormInfo -> FCode () -- Called when doing a dynamic heap allocation -tickyDynAlloc cl_info +-- LambdaFormInfo only needed to distinguish between updatable/non-updatable thunks +tickyDynAlloc rep lf = ifTicky $ case () of - _ | Just _ <- maybeIsLFCon lf -> tick_alloc_con - | isLFThunk lf -> tick_alloc_thk - | isLFReEntrant lf -> tick_alloc_fun - | otherwise -> return () + _ | isConRep rep -> tick_alloc_con + | isThunkRep rep -> tick_alloc_thk + | isFunRep rep -> tick_alloc_fun + | otherwise -> return () where - lf = closureLFInfo cl_info - - -- will be needed when we fill in stubs - _cl_size = closureSize cl_info + -- will be needed when we fill in stubs + _cl_size = heapClosureSize rep -- _slop_size = slopSize cl_info tick_alloc_thk - | closureUpdReqd cl_info = tick_alloc_up_thk - | otherwise = tick_alloc_se_thk + | lfUpdatable lf = tick_alloc_up_thk + | otherwise = tick_alloc_se_thk -- krc: changed from panic to return () -- just to get something working |