Commit dd391759 authored by batterseapower's avatar batterseapower

Don't export the _info symbol for the data constructor worker bindings

This is safe because GHC never generates a fast call to a data constructor
worker: if the call is seen statically it will be eta-expanded and the
allocation of the data will be inlined. We still need to export the _closure
in case the constructor is used in an unapplied fashion.
parent 41ca0b8d
......@@ -100,6 +100,7 @@ module CLabel (
hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
localiseLabel,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
isMathFun,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
......@@ -278,11 +279,14 @@ pprDebugCLabel lbl
_ -> ppr lbl <> (parens $ text "other CLabel)")
-- True if a local IdLabel that we won't mark as exported
type IsLocal = Bool
data IdLabelInfo
= Closure -- ^ Label for closure
| SRT -- ^ Static reference table
| InfoTable -- ^ Info tables for closures; always read-only
| Entry -- ^ Entry point
| InfoTable IsLocal -- ^ Info tables for closures; always read-only
| Entry IsLocal -- ^ Entry point
| Slow -- ^ Slow entry point
| RednCounts -- ^ Label of place to keep Ticky-ticky info for this Id
......@@ -356,13 +360,13 @@ mkRednCountsLabel name c = IdLabel name c RednCounts
-- These have local & (possibly) external variants:
mkLocalClosureLabel name c = IdLabel name c Closure
mkLocalInfoTableLabel name c = IdLabel name c InfoTable
mkLocalEntryLabel name c = IdLabel name c Entry
mkLocalInfoTableLabel name c = IdLabel name c (InfoTable True)
mkLocalEntryLabel name c = IdLabel name c (Entry True)
mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
mkClosureLabel name c = IdLabel name c Closure
mkInfoTableLabel name c = IdLabel name c InfoTable
mkEntryLabel name c = IdLabel name c Entry
mkInfoTableLabel name c = IdLabel name c (InfoTable False)
mkEntryLabel name c = IdLabel name c (Entry False)
mkClosureTableLabel name c = IdLabel name c ClosureTable
mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
mkLocalConEntryLabel c con = IdLabel con c ConEntry
......@@ -498,7 +502,7 @@ mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
-- Converting between info labels and entry/ret labels.
infoLblToEntryLbl :: CLabel -> CLabel
infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
infoLblToEntryLbl (IdLabel n c (InfoTable lcl)) = IdLabel n c (Entry lcl)
infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
......@@ -509,7 +513,7 @@ infoLblToEntryLbl _
entryLblToInfoLbl :: CLabel -> CLabel
entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
entryLblToInfoLbl (IdLabel n c (Entry lcl)) = IdLabel n c (InfoTable lcl)
entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
......@@ -519,8 +523,8 @@ entryLblToInfoLbl l
= pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c Entry) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c (InfoTable _)) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c (Entry _)) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c RednCounts) = IdLabel n c Closure
cvtToClosureLbl l@(IdLabel n c Closure) = l
......@@ -528,13 +532,18 @@ cvtToClosureLbl l
= pprPanic "cvtToClosureLbl" (pprCLabel l)
cvtToSRTLbl (IdLabel n c InfoTable) = mkSRTLabel n c
cvtToSRTLbl (IdLabel n c Entry) = mkSRTLabel n c
cvtToSRTLbl (IdLabel n c (InfoTable _)) = mkSRTLabel n c
cvtToSRTLbl (IdLabel n c (Entry _)) = mkSRTLabel n c
cvtToSRTLbl (IdLabel n c ConEntry) = mkSRTLabel n c
cvtToSRTLbl l@(IdLabel n c Closure) = mkSRTLabel n c
cvtToSRTLbl l
= pprPanic "cvtToSRTLbl" (pprCLabel l)
localiseLabel :: CLabel -> CLabel
localiseLabel (IdLabel n c (Entry _)) = IdLabel n c (Entry True)
localiseLabel (IdLabel n c (InfoTable _)) = IdLabel n c (InfoTable True)
localiseLabel l = l
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
......@@ -700,8 +709,10 @@ externallyVisibleCLabel (LargeBitmapLabel _) = False
externallyVisibleCLabel (LargeSRTLabel _) = False
externallyVisibleIdLabel :: IdLabelInfo -> Bool
externallyVisibleIdLabel SRT = False
externallyVisibleIdLabel _ = True
externallyVisibleIdLabel SRT = False
externallyVisibleIdLabel (Entry lcl) = not lcl
externallyVisibleIdLabel (InfoTable lcl) = not lcl
externallyVisibleIdLabel _ = True
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel
......@@ -748,7 +759,7 @@ labelType _ = DataLabel
idInfoLabelType info =
case info of
InfoTable -> DataLabel
InfoTable _ -> DataLabel
Closure -> GcPtrLabel
ConInfoTable -> DataLabel
StaticInfoTable -> DataLabel
......@@ -984,8 +995,8 @@ ppIdFlavor x = pp_cSEP <>
(case x of
Closure -> ptext (sLit "closure")
SRT -> ptext (sLit "srt")
InfoTable -> ptext (sLit "info")
Entry -> ptext (sLit "entry")
InfoTable _ -> ptext (sLit "info")
Entry _ -> ptext (sLit "entry")
Slow -> ptext (sLit "slow")
RednCounts -> ptext (sLit "ct")
ConEntry -> ptext (sLit "con_entry")
......
......@@ -336,7 +336,7 @@ localCAFInfo :: CAFEnv -> CmmTop -> Maybe (CLabel, CAFSet)
localCAFInfo _ (CmmData _ _) = Nothing
localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
case info_tbl top_info of
CmmInfoTable False _ _ _ ->
CmmInfoTable _ False _ _ _ ->
Just (cvtToClosureLbl top_l,
expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
_ -> Nothing
......@@ -397,8 +397,8 @@ updInfo toVars toSrt (CmmProc top_info top_l g) =
updInfo _ _ t = t
updInfoTbl :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmInfoTable -> CmmInfoTable
updInfoTbl toVars toSrt (CmmInfoTable s p t typeinfo)
= CmmInfoTable s p t typeinfo'
updInfoTbl toVars toSrt (CmmInfoTable l s p t typeinfo)
= CmmInfoTable l s p t typeinfo'
where typeinfo' = case typeinfo of
t@(ConstrInfo _ _ _) -> t
(FunInfo c s a d e) -> FunInfo c (toSrt s) a d e
......
......@@ -70,12 +70,16 @@ data GenCmmTop d h g
-- Info table as a haskell data type
data CmmInfoTable
= CmmInfoTable
LocalInfoTable
HasStaticClosure
ProfilingInfo
ClosureTypeTag -- Int
ClosureTypeInfo
| CmmNonInfoTable -- Procedure doesn't need an info table
-- | If the table is local, we don't export its identifier even if the corresponding Id is exported.
-- It's always safe to say 'False' here, but it might save symbols to say 'True'
type LocalInfoTable = Bool
type HasStaticClosure = Bool
-- TODO: The GC target shouldn't really be part of CmmInfo
......
......@@ -28,7 +28,7 @@ import Data.Bits
-- When we split at proc points, we need an empty info table.
emptyContInfoTable :: CmmInfoTable
emptyContInfoTable = CmmInfoTable False (ProfilingInfo zero zero) rET_SMALL
emptyContInfoTable = CmmInfoTable False False (ProfilingInfo zero zero) rET_SMALL
(ContInfo [] NoC_SRT)
where zero = CmmInt 0 wordWidth
......@@ -80,8 +80,8 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label blocks) =
-- Code without an info table. Easy.
CmmNonInfoTable -> [CmmProc Nothing entry_label blocks]
CmmInfoTable _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
let info_label = entryLblToInfoLbl entry_label
CmmInfoTable is_local _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
let info_label = (if is_local then localiseLabel else id) $ entryLblToInfoLbl entry_label
ty_prof' = makeRelativeRefTo info_label ty_prof
cl_prof' = makeRelativeRefTo info_label cl_prof
in case type_info of
......
......@@ -266,7 +266,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
{% withThisPackage $ \pkg ->
do prof <- profilingInfo $11 $13
return (mkCmmEntryLabel pkg $3,
CmmInfoTable False prof (fromIntegral $9)
CmmInfoTable False False prof (fromIntegral $9)
(ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
[]) }
......@@ -275,7 +275,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
{% withThisPackage $ \pkg ->
do prof <- profilingInfo $11 $13
return (mkCmmEntryLabel pkg $3,
CmmInfoTable False prof (fromIntegral $9)
CmmInfoTable False False prof (fromIntegral $9)
(FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT
0 -- Arity zero
(ArgSpec (fromIntegral $15))
......@@ -290,7 +290,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
{% withThisPackage $ \pkg ->
do prof <- profilingInfo $11 $13
return (mkCmmEntryLabel pkg $3,
CmmInfoTable False prof (fromIntegral $9)
CmmInfoTable False False prof (fromIntegral $9)
(FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $17)
(ArgSpec (fromIntegral $15))
zeroCLit),
......@@ -306,7 +306,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
-- but that's the way the old code did it we can fix it some other time.
desc_lit <- code $ mkStringCLit $13
return (mkCmmEntryLabel pkg $3,
CmmInfoTable False prof (fromIntegral $11)
CmmInfoTable False False prof (fromIntegral $11)
(ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit),
[]) }
......@@ -315,7 +315,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
{% withThisPackage $ \pkg ->
do prof <- profilingInfo $9 $11
return (mkCmmEntryLabel pkg $3,
CmmInfoTable False prof (fromIntegral $7)
CmmInfoTable False False prof (fromIntegral $7)
(ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
[]) }
......@@ -324,7 +324,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
{% withThisPackage $ \pkg ->
do let infoLabel = mkCmmInfoLabel pkg $3
return (mkCmmRetLabel pkg $3,
CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
CmmInfoTable False False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo [] NoC_SRT),
[]) }
......@@ -333,7 +333,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
{% withThisPackage $ \pkg ->
do live <- sequence (map (liftM Just) $7)
return (mkCmmRetLabel pkg $3,
CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
CmmInfoTable False False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo live NoC_SRT),
live) }
......
......@@ -88,7 +88,7 @@ pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
maybe (ptext (sLit "<none>")) ppr gc_target,-}
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
pprInfo (CmmInfo _gc_target update_frame info_table@(CmmInfoTable _ _ _ _)) =
pprInfo (CmmInfo _gc_target update_frame info_table@(CmmInfoTable _ _ _ _ _)) =
vcat [{-ptext (sLit "gc_target: ") <>
maybe (ptext (sLit "<none>")) ppr gc_target,-}
ptext (sLit "update_frame: ") <>
......
......@@ -114,8 +114,9 @@ pprTop (CmmData section ds) =
pprInfoTable :: CmmInfoTable -> SDoc
pprInfoTable CmmNonInfoTable = empty
pprInfoTable (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info) =
vcat [ptext (sLit "has static closure: ") <> ppr stat_clos <+>
pprInfoTable (CmmInfoTable is_local stat_clos (ProfilingInfo closure_type closure_desc) tag info) =
vcat [ptext (sLit "is local: ") <> ppr is_local <+>
ptext (sLit "has static closure: ") <> ppr stat_clos <+>
ptext (sLit "type: ") <> pprLit closure_type,
ptext (sLit "desc: ") <> pprLit closure_desc,
ptext (sLit "tag: ") <> integer (toInteger tag),
......
......@@ -84,12 +84,12 @@ mkCmmInfo cl_info = do
info = ConstrInfo (ptrs, nptrs)
(fromIntegral (dataConTagZ con))
conName
return $ CmmInfo gc_target Nothing (CmmInfoTable False prof cl_type info)
return $ CmmInfo gc_target Nothing (CmmInfoTable False False prof cl_type info)
ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureSRT = srt } ->
return $ CmmInfo gc_target Nothing (CmmInfoTable False prof cl_type info)
return $ CmmInfo gc_target Nothing (CmmInfoTable (closureInfoLocal cl_info) False prof cl_type info)
where
info =
case lf_info of
......@@ -142,7 +142,7 @@ emitReturnTarget name stmts
; let info = CmmInfo
gc_target
Nothing
(CmmInfoTable False
(CmmInfoTable False False
(ProfilingInfo zeroCLit zeroCLit)
rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
(ContInfo frame srt_info))
......
......@@ -50,7 +50,7 @@ module ClosureInfo (
isToplevClosure,
closureValDescr, closureTypeDescr, -- profiling
isStaticClosure,
closureInfoLocal, isStaticClosure,
cafBlackHoleClosureInfo,
staticClosureNeedsLink,
......@@ -111,7 +111,8 @@ data ClosureInfo
closureSMRep :: !SMRep, -- representation used by storage mgr
closureSRT :: !C_SRT, -- What SRT applies to this closure
closureType :: !Type, -- Type of closure (ToDo: remove)
closureDescr :: !String -- closure description (for profiling)
closureDescr :: !String, -- closure description (for profiling)
closureInfLcl :: Bool -- can the info pointer be a local symbol?
}
-- Constructor closures don't have a unique info table label (they use
......@@ -341,7 +342,12 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
closureSMRep = sm_rep,
closureSRT = srt_info,
closureType = idType id,
closureDescr = descr }
closureDescr = descr,
closureInfLcl = isDataConWorkId id }
-- Make the _info pointer for the implicit datacon worker binding
-- local. The reason we can do this is that importing code always
-- either uses the _closure or _con_info. By the invariants in CorePrep
-- anything else gets eta expanded.
where
name = idName id
sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
......@@ -842,6 +848,9 @@ staticClosureRequired _ _ _ = True
%************************************************************************
\begin{code}
closureInfoLocal :: ClosureInfo -> Bool
closureInfoLocal ClosureInfo{ closureInfLcl = lcl } = lcl
closureInfoLocal ConInfo{} = False
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
......@@ -927,9 +936,9 @@ infoTableLabelFromCI (ClosureInfo { closureName = name,
LFThunk _ _ upd_flag (ApThunk arity) _ ->
mkApInfoTableLabel upd_flag arity
LFThunk{} -> mkLocalInfoTableLabel name caf
LFThunk{} -> mkInfoTableLabel name caf
LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf
LFReEntrant _ _ _ _ -> mkInfoTableLabel name caf
_ -> panic "infoTableLabelFromCI"
......@@ -1003,7 +1012,8 @@ cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
closureSMRep = BlackHoleRep,
closureSRT = NoC_SRT,
closureType = ty,
closureDescr = "" }
closureDescr = "",
closureInfLcl = False }
cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
\end{code}
......
......@@ -56,7 +56,7 @@ module StgCmmClosure (
isToplevClosure,
closureValDescr, closureTypeDescr, -- profiling
isStaticClosure,
closureInfoLocal, isStaticClosure,
cafBlackHoleClosureInfo,
staticClosureNeedsLink, clHasCafRefs
......@@ -679,7 +679,8 @@ data ClosureInfo
closureSRT :: !C_SRT, -- What SRT applies to this closure
closureType :: !Type, -- Type of closure (ToDo: remove)
closureDescr :: !String, -- closure description (for profiling)
closureCafs :: !CafInfo -- whether the closure may have CAFs
closureCafs :: !CafInfo, -- whether the closure may have CAFs
closureInfLcl :: Bool -- can the info pointer be a local symbol?
}
-- Constructor closures don't have a unique info table label (they use
......@@ -725,7 +726,12 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
closureSRT = srt_info,
closureType = idType id,
closureDescr = descr,
closureCafs = idCafInfo id }
closureCafs = idCafInfo id,
closureInfLcl = isDataConWorkId id }
-- Make the _info pointer for the implicit datacon worker binding
-- local. The reason we can do this is that importing code always
-- either uses the _closure or _con_info. By the invariants in CorePrep
-- anything else gets eta expanded.
where
name = idName id
sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
......@@ -756,7 +762,8 @@ cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
closureSRT = NoC_SRT,
closureType = ty,
closureDescr = "",
closureCafs = cafs }
closureCafs = cafs,
closureInfLcl = False }
cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
......@@ -931,6 +938,10 @@ staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
GenericRep _ _ _ ConstrNoCaf -> False
_other -> True
closureInfoLocal :: ClosureInfo -> Bool
closureInfoLocal ClosureInfo{ closureInfLcl = lcl } = lcl
closureInfoLocal ConInfo{} = False
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
......@@ -997,9 +1008,9 @@ infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
LFThunk _ _ upd_flag (ApThunk arity) _ ->
mkApInfoTableLabel upd_flag arity
LFThunk{} -> mkLocalInfoTableLabel name $ clHasCafRefs cl
LFThunk{} -> mkInfoTableLabel name $ clHasCafRefs cl
LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name $ clHasCafRefs cl
LFReEntrant _ _ _ _ -> mkInfoTableLabel name $ clHasCafRefs cl
_other -> panic "infoTableLabelFromCI"
......
......@@ -496,7 +496,7 @@ mkCmmInfo cl_info
ad_lit <- mkStringCLit (closureValDescr cl_info)
return $ ProfilingInfo fd_lit ad_lit
else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
; return (CmmInfoTable (isStaticClosure cl_info) prof cl_type info) }
; return (CmmInfoTable (closureInfoLocal cl_info) (isStaticClosure cl_info) prof cl_type info) }
where
k_with_con_name con_info con info_lbl =
do cstr <- mkByteStringCLit $ dataConIdentity con
......
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