Commit 046755fd authored by batterseapower's avatar batterseapower

Eliminate infoLblToEntryLbl

parent ef88b16d
......@@ -65,6 +65,7 @@ module CLabel (
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
mkCAFBlackHoleEntryLabel,
mkRtsPrimOpLabel,
mkRtsSlowTickyCtrLabel,
......@@ -99,7 +100,7 @@ module CLabel (
mkHpcTicksLabel,
hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
localiseLabel,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
isMathFun,
......@@ -390,6 +391,7 @@ mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY")
mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") CmmInfo
mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData
mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
mkCAFBlackHoleEntryLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmEntry
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
......@@ -501,17 +503,6 @@ mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
-- -----------------------------------------------------------------------------
-- Converting between info labels and entry/ret labels.
infoLblToEntryLbl :: CLabel -> CLabel
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
infoLblToEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
infoLblToEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
infoLblToEntryLbl _
= panic "CLabel.infoLblToEntryLbl"
entryLblToInfoLbl :: CLabel -> CLabel
entryLblToInfoLbl (IdLabel n c (Entry lcl)) = IdLabel n c (InfoTable lcl)
entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
......
......@@ -80,6 +80,8 @@ import FastString
import Outputable
import Constants
import DynFlags
import Control.Arrow ((***))
\end{code}
......@@ -925,33 +927,39 @@ Label generation.
\begin{code}
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureInfLcl = is_lcl })
= (if is_lcl then localiseLabel else id) $ case lf_info of
LFBlackHole -> mkCAFBlackHoleInfoTableLabel
infoTableLabelFromCI = fst . labelsFromCI
entryLabelFromCI :: ClosureInfo -> CLabel
entryLabelFromCI = snd . labelsFromCI
labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry)
labelsFromCI cl@(ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureInfLcl = is_lcl })
= (if is_lcl then (localiseLabel *** localiseLabel) else id) $ case lf_info of
LFBlackHole -> (mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel)
LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
mkSelectorInfoLabel upd_flag offset
bothL (mkSelectorInfoLabel, mkSelectorEntryLabel) upd_flag offset
LFThunk _ _ upd_flag (ApThunk arity) _ ->
mkApInfoTableLabel upd_flag arity
bothL (mkApInfoTableLabel, mkApEntryLabel) upd_flag arity
LFThunk{} -> mkInfoTableLabel name $ clHasCafRefs cl
LFThunk{} -> bothL (mkInfoTableLabel, mkEntryLabel) name $ clHasCafRefs cl
LFReEntrant _ _ _ _ -> mkInfoTableLabel name $ clHasCafRefs cl
LFReEntrant _ _ _ _ -> bothL (mkInfoTableLabel, mkEntryLabel) name $ clHasCafRefs cl
_ -> panic "infoTableLabelFromCI"
_ -> panic "labelsFromCI"
infoTableLabelFromCI cl@(ConInfo { closureCon = con,
labelsFromCI cl@(ConInfo { closureCon = con,
closureSMRep = rep })
| isStaticRep rep = mkStaticInfoTableLabel name $ clHasCafRefs cl
| otherwise = mkConInfoTableLabel name $ clHasCafRefs cl
| isStaticRep rep = bothL (mkStaticInfoTableLabel, mkStaticConEntryLabel) name $ clHasCafRefs cl
| otherwise = bothL (mkConInfoTableLabel, mkConEntryLabel) name $ clHasCafRefs cl
where
name = dataConName con
entryLabelFromCI :: ClosureInfo -> CLabel
entryLabelFromCI = infoLblToEntryLbl . infoTableLabelFromCI
bothL :: (a -> b -> c, a -> b -> c) -> a -> b -> (c, c)
bothL (f, g) x y = (f x y, g x y)
-- ClosureInfo for a closure (as opposed to a constructor) is always local
closureLabelFromCI :: ClosureInfo -> CLabel
......
......@@ -90,6 +90,8 @@ import Outputable
import Constants
import DynFlags
import Control.Arrow ((***))
-----------------------------------------------------------------------------
-- Representations
-----------------------------------------------------------------------------
......@@ -992,32 +994,38 @@ isToplevClosure _ = False
--------------------------------------
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureInfLcl = is_lcl })
= (if is_lcl then localiseLabel else id) $ case lf_info of
LFBlackHole -> mkCAFBlackHoleInfoTableLabel
infoTableLabelFromCI = fst . labelsFromCI
entryLabelFromCI :: ClosureInfo -> CLabel
entryLabelFromCI = snd . labelsFromCI
labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry)
labelsFromCI cl@(ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureInfLcl = is_lcl })
= (if is_lcl then (localiseLabel *** localiseLabel) else id) $ case lf_info of
LFBlackHole -> (mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel)
LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
mkSelectorInfoLabel upd_flag offset
bothL (mkSelectorInfoLabel, mkSelectorEntryLabel) upd_flag offset
LFThunk _ _ upd_flag (ApThunk arity) _ ->
mkApInfoTableLabel upd_flag arity
bothL (mkApInfoTableLabel, mkApEntryLabel) upd_flag arity
LFThunk{} -> mkInfoTableLabel name $ clHasCafRefs cl
LFThunk{} -> bothL (mkInfoTableLabel, mkEntryLabel) name $ clHasCafRefs cl
LFReEntrant _ _ _ _ -> mkInfoTableLabel name $ clHasCafRefs cl
LFReEntrant _ _ _ _ -> bothL (mkInfoTableLabel, mkEntryLabel) name $ clHasCafRefs cl
_other -> panic "infoTableLabelFromCI"
_other -> panic "labelsFromCI"
infoTableLabelFromCI cl@(ConInfo { closureCon = con, closureSMRep = rep })
| isStaticRep rep = mkStaticInfoTableLabel name $ clHasCafRefs cl
| otherwise = mkConInfoTableLabel name $ clHasCafRefs cl
labelsFromCI cl@(ConInfo { closureCon = con, closureSMRep = rep })
| isStaticRep rep = bothL (mkStaticInfoTableLabel, mkStaticConEntryLabel) name $ clHasCafRefs cl
| otherwise = bothL (mkConInfoTableLabel, mkConEntryLabel) name $ clHasCafRefs cl
where
name = dataConName con
entryLabelFromCI :: ClosureInfo -> CLabel
entryLabelFromCI = infoLblToEntryLbl . infoTableLabelFromCI
bothL :: (a -> b -> c, a -> b -> c) -> a -> b -> (c, c)
bothL (f, g) x y = (f x y, g x y)
-- ClosureInfo for a closure (as opposed to a constructor) is always local
closureLabelFromCI :: ClosureInfo -> CLabel
......
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