Commit 06447893 authored by Simon Marlow's avatar Simon Marlow

Remove another use of mkConInfo

parent a6315fc7
......@@ -10,27 +10,33 @@ Other modules should access this info through ClosureInfo.
\begin{code}
module SMRep (
-- Words and bytes
-- * Words and bytes
StgWord, StgHalfWord,
hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
WordOff, ByteOff,
-- Closure repesentation
-- * Closure repesentation
SMRep(..), -- CmmInfo sees the rep; no one else does
IsStatic,
ClosureTypeInfo(..), ArgDescr(..), Liveness,
ConstrDescription,
-- ** Construction
mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep,
isStaticRep, isStaticNoCafCon,
-- ** Predicates
isStaticRep, isConRep, isThunkRep, isStaticNoCafCon,
-- ** Size-related things
heapClosureSize,
fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
profHdrSize, thunkHdrSize, nonHdrSize,
rtsClosureType, rET_SMALL, rET_BIG,
-- ** RTS closure types
rtsClosureType, rET_SMALL, rET_BIG,
aRG_GEN, aRG_GEN_BIG,
-- Operations over [Word8] strings
-- * Operations over [Word8] strings that don't belong here
pprWord8String, stringToWord8s
) where
......@@ -172,6 +178,31 @@ mkStackRep liveness = StackRep liveness
blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole
-----------------------------------------------------------------------------
-- Predicates
isStaticRep :: SMRep -> IsStatic
isStaticRep (HeapRep is_static _ _ _) = is_static
isStaticRep (StackRep {}) = False
isStaticRep (RTSRep _ rep) = isStaticRep rep
isConRep :: SMRep -> Bool
isConRep (HeapRep _ _ _ Constr{}) = True
isConRep _ = False
isThunkRep :: SMRep -> Bool
isThunkRep (HeapRep _ _ _ Thunk{}) = True
isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
isThunkRep (HeapRep _ _ _ BlackHole{}) = True
isThunkRep _ = False
isStaticNoCafCon :: SMRep -> Bool
-- This should line up exactly with CONSTR_NOCAF_STATIC above
-- See Note [Static NoCaf constructors]
isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True
isStaticNoCafCon _ = False
-----------------------------------------------------------------------------
-- Size-related things
......@@ -202,11 +233,6 @@ thunkHdrSize = fixedHdrSize + smp_hdr
where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE
isStaticRep :: SMRep -> IsStatic
isStaticRep (HeapRep is_static _ _ _) = is_static
isStaticRep (StackRep {}) = False
isStaticRep (RTSRep _ rep) = isStaticRep rep
nonHdrSize :: SMRep -> WordOff
nonHdrSize (HeapRep _ p np _) = p + np
nonHdrSize (StackRep bs) = length bs
......@@ -273,12 +299,6 @@ rtsClosureType (HeapRep False _ _ BlackHole{}) = BLACKHOLE
rtsClosureType _ = panic "rtsClosureType"
isStaticNoCafCon :: SMRep -> Bool
-- This should line up exactly with CONSTR_NOCAF_STATIC above
-- See Note [Static NoCaf constructors]
isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True
isStaticNoCafCon _ = False
-- We export these ones
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: StgHalfWord
rET_SMALL = RET_SMALL
......@@ -345,6 +365,7 @@ pprTypeInfo (ThunkSelector offset)
pprTypeInfo Thunk = ptext (sLit "Thunk")
pprTypeInfo BlackHole = ptext (sLit "BlackHole")
-- XXX Does not belong here!!
stringToWord8s :: String -> [Word8]
stringToWord8s s = map (fromIntegral . ord) s
......
......@@ -75,7 +75,8 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do
closure_label = mkLocalClosureLabel name (idCafInfo id)
cg_id_info = litIdInfo id lf_info (CmmLabel closure_label)
caffy = idCafInfo id
closure_rep = mkStaticClosureFields closure_info ccs caffy []
info_tbl = mkCmmInfo closure_info -- XXX short-cut
closure_rep = mkStaticClosureFields info_tbl ccs caffy []
-- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
; emitDataLits closure_label closure_rep
......
......@@ -39,7 +39,7 @@ module StgCmmClosure (
closureName, infoTableLabelFromCI, entryLabelFromCI,
closureLabelFromCI, closureProf, closureSRT,
closureLFInfo, closureSMRep, closureUpdReqd,
closureNeedsUpdSpace, closureIsThunk,
closureIsThunk,
closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
closureFunInfo, isStandardFormThunk, isKnownFun,
funTag, tagForArity,
......@@ -763,15 +763,6 @@ mkCmmInfo cl_info
closureSize :: ClosureInfo -> WordOff
closureSize cl_info = heapClosureSize (closureSMRep cl_info)
closureNeedsUpdSpace :: ClosureInfo -> Bool
-- We leave space for an update if either (a) the closure is updatable
-- or (b) it is a static thunk. This is because a static thunk needs
-- a static link field in a predictable place (after the slop), regardless
-- of whether it is updatable or not.
closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
LFThunk TopLevel _ _ _ _ }) = True
closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
--------------------------------------
-- Other functions over ClosureInfo
--------------------------------------
......@@ -801,19 +792,6 @@ blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = r
_other -> panic "blackHoleOnEntry" -- Should never happen
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 constructor with one or more pointer fields
-- In case (b), the constructor's fields themselves play the role
-- of the SRT.
staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
= needsSRT srt
staticClosureNeedsLink (ConInfo { closureSMRep = rep })
= not (isStaticNoCafCon rep)
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
......@@ -980,7 +958,7 @@ getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
getPredTyDescription (EqPred {}) = "Type equality"
--------------------------------------
-- Misc things
-- CmmInfoTable-related things
--------------------------------------
mkDataConInfoTable :: DataCon -> Bool -> Int -> Int -> CmmInfoTable
......@@ -1005,3 +983,16 @@ mkDataConInfoTable data_con is_static ptr_wds nonptr_wds
ty_descr = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con
val_descr = stringToWord8s $ occNameString $ getOccName data_con
staticClosureNeedsLink :: CmmInfoTable -> 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 constructor with one or more pointer fields
-- In case (b), the constructor's fields themselves play the role
-- of the SRT.
staticClosureNeedsLink info_tbl@CmmInfoTable{ cit_rep = smrep }
| isConRep smrep = not (isStaticNoCafCon smrep)
| otherwise = needsSRT (cit_srt info_tbl)
staticClosureNeedsLink _ = False
......@@ -67,15 +67,20 @@ cgTopRhsCon id con args
-- LAY IT OUT
; let
name = idName id
lf_info = mkConLFInfo con
closure_label = mkClosureLabel name caffy
caffy = idCafInfo id -- any stgArgHasCafRefs args
(tot_wds, -- #ptr_wds + #nonptr_wds
name = idName id
caffy = idCafInfo id -- any stgArgHasCafRefs args
closure_label = mkClosureLabel name caffy
(tot_wds, -- #ptr_wds + #nonptr_wds
ptr_wds, -- #ptr_wds
nv_args_w_offsets) = mkVirtConstrOffsets (addArgReps args)
closure_info = mkConInfo True caffy con tot_wds ptr_wds
nonptr_wds = tot_wds - ptr_wds
-- we're not really going to emit an info table, so having
-- to make a CmmInfoTable is a bit overkill, but mkStaticClosureFields
-- needs to poke around inside it.
info_tbl = mkDataConInfoTable con True ptr_wds nonptr_wds
get_lit (arg, _offset) = do { CmmLit lit <- getArgAmode arg
; return lit }
......@@ -85,7 +90,7 @@ cgTopRhsCon id con args
-- NB2: all the amodes should be Lits!
; let closure_rep = mkStaticClosureFields
closure_info
info_tbl
dontCareCCS -- Because it's static data
caffy -- Has CAF refs
payload
......@@ -93,8 +98,8 @@ cgTopRhsCon id con args
-- BUILD THE OBJECT
; emitDataLits closure_label closure_rep
-- RETURN
; return $ litIdInfo id lf_info (CmmLabel closure_label) }
-- RETURN
; return $ litIdInfo id (mkConLFInfo con) (CmmLabel closure_label) }
---------------------------------------------------------------
......
......@@ -149,16 +149,16 @@ hpStore base vals offs
-- and adding a static link field if necessary.
mkStaticClosureFields
:: ClosureInfo
:: CmmInfoTable
-> CostCentreStack
-> CafInfo
-> [CmmLit] -- Payload
-> [CmmLit] -- The full closure
mkStaticClosureFields cl_info ccs caf_refs payload
mkStaticClosureFields info_tbl ccs caf_refs payload
= mkStaticClosure info_lbl ccs payload padding
static_link_field saved_info_field
where
info_lbl = infoTableLabelFromCI cl_info
info_lbl = cit_lbl info_tbl
-- CAFs must have consistent layout, regardless of whether they
-- are actually updatable or not. The layout of a CAF is:
......@@ -168,19 +168,19 @@ mkStaticClosureFields cl_info ccs caf_refs payload
-- 1 indirectee
-- 0 info ptr
--
-- the static_link and saved_info fields must always be in the same
-- place. So we use closureNeedsUpdSpace rather than
-- closureUpdReqd here:
-- the static_link and saved_info fields must always be in the
-- same place. So we use isThunkRep rather than closureUpdReqd
-- here:
is_caf = closureNeedsUpdSpace cl_info
is_caf = isThunkRep (cit_rep info_tbl)
padding
| not is_caf = []
| otherwise = ASSERT(null payload) [mkIntCLit 0]
static_link_field
| is_caf || staticClosureNeedsLink cl_info = [static_link_value]
| otherwise = []
| is_caf || staticClosureNeedsLink info_tbl = [static_link_value]
| otherwise = []
saved_info_field
| is_caf = [mkIntCLit 0]
......
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