Skip to content

GitLab

Commit 4ebf65ab authored by Simon Marlow's avatar Simon Marlow
Browse files
Options

eliminate ConInfo

parent 06447893
Hide whitespace changes
Inline Side-by-side
Showing with 74 additions and 107 deletions
compiler/cmm/SMRep.lhs
View file @ 4ebf65ab
......@@ -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]
......
compiler/codeGen/StgCmm.hs
View file @ 4ebf65ab
......@@ -24,7 +24,6 @@ import StgCmmTicky
import Cmm
import CLabel
import PprCmm
import StgSyn
import DynFlags
......
compiler/codeGen/StgCmmBind.hs
View file @ 4ebf65ab
......@@ -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
......
compiler/codeGen/StgCmmClosure.hs
View file @ 4ebf65ab
......@@ -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
compiler/codeGen/StgCmmCon.hs
View file @ 4ebf65ab
......@@ -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
......
compiler/codeGen/StgCmmHeap.hs
View file @ 4ebf65ab
......@@ -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]
......
compiler/codeGen/StgCmmProf.hs
View file @ 4ebf65ab
......@@ -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
......
compiler/codeGen/StgCmmTicky.hs
View file @ 4ebf65ab
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment