Commit eb8115a8 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Move CLabel assertions into smart constructors (#17957)

It avoids using DynFlags in the Outputable instance of Clabel to check
assertions at pretty-printing time.
parent 4cab6897
Pipeline #21082 failed with stages
in 278 minutes and 48 seconds
......@@ -567,17 +567,27 @@ mkLocalBlockLabel u = LocalBlockLabel u
-- Constructing RtsLabels
mkRtsPrimOpLabel :: PrimOp -> CLabel
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
mkSelectorInfoLabel :: Bool -> Int -> CLabel
mkSelectorEntryLabel :: Bool -> Int -> CLabel
mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
mkSelectorInfoLabel :: DynFlags -> Bool -> Int -> CLabel
mkSelectorInfoLabel dflags upd offset =
ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
RtsLabel (RtsSelectorInfoTable upd offset)
mkApInfoTableLabel :: Bool -> Int -> CLabel
mkApEntryLabel :: Bool -> Int -> CLabel
mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
mkSelectorEntryLabel :: DynFlags -> Bool -> Int -> CLabel
mkSelectorEntryLabel dflags upd offset =
ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
RtsLabel (RtsSelectorEntry upd offset)
mkApInfoTableLabel :: DynFlags -> Bool -> Int -> CLabel
mkApInfoTableLabel dflags upd arity =
ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
RtsLabel (RtsApInfoTable upd arity)
mkApEntryLabel :: DynFlags -> Bool -> Int -> CLabel
mkApEntryLabel dflags upd arity =
ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
RtsLabel (RtsApEntry upd arity)
-- A call to some primitive hand written Cmm code
......@@ -1209,7 +1219,7 @@ pprCLabel dflags = \case
lbl -> getPprStyle $ \sty ->
if useNCG && asmStyle sty
then maybe_underscore $ pprAsmCLbl lbl
else pprCLbl dflags lbl
else pprCLbl platform lbl
where
platform = targetPlatform dflags
......@@ -1226,10 +1236,10 @@ pprCLabel dflags = \case
-- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-- (The C compiler does this itself).
= ftext fs <> char '@' <> int sz
pprAsmCLbl lbl = pprCLbl dflags lbl
pprAsmCLbl lbl = pprCLbl platform lbl
pprCLbl :: DynFlags -> CLabel -> SDoc
pprCLbl dflags = \case
pprCLbl :: Platform -> CLabel -> SDoc
pprCLbl platform = \case
(StringLitLabel u) -> pprUniqueAlways u <> text "_str"
(SRTLabel u) -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
(LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform
......@@ -1247,7 +1257,6 @@ pprCLbl dflags = \case
(RtsLabel (RtsApFast str)) -> ftext str <> text "_fast"
(RtsLabel (RtsSelectorInfoTable upd_reqd offset)) ->
ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
hcat [text "stg_sel_", text (show offset),
ptext (if upd_reqd
then (sLit "_upd_info")
......@@ -1255,7 +1264,6 @@ pprCLbl dflags = \case
]
(RtsLabel (RtsSelectorEntry upd_reqd offset)) ->
ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
hcat [text "stg_sel_", text (show offset),
ptext (if upd_reqd
then (sLit "_upd_entry")
......@@ -1263,7 +1271,6 @@ pprCLbl dflags = \case
]
(RtsLabel (RtsApInfoTable upd_reqd arity)) ->
ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
hcat [text "stg_ap_", text (show arity),
ptext (if upd_reqd
then (sLit "_upd_info")
......@@ -1271,7 +1278,6 @@ pprCLbl dflags = \case
]
(RtsLabel (RtsApEntry upd_reqd arity)) ->
ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
hcat [text "stg_ap_", text (show arity),
ptext (if upd_reqd
then (sLit "_upd_entry")
......@@ -1301,8 +1307,6 @@ pprCLbl dflags = \case
(DynamicLinkerLabel {}) -> panic "pprCLbl DynamicLinkerLabel"
(PicBaseLabel {}) -> panic "pprCLbl PicBaseLabel"
(DeadStripPreventer {}) -> panic "pprCLbl DeadStripPreventer"
where
platform = targetPlatform dflags
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <> text
......
......@@ -637,7 +637,7 @@ mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
prof = mkProfilingInfo dflags id val_descr
nonptr_wds = tot_wds - ptr_wds
info_lbl = mkClosureInfoTableLabel id lf_info
info_lbl = mkClosureInfoTableLabel dflags id lf_info
--------------------------------------
-- Other functions over ClosureInfo
......@@ -786,14 +786,14 @@ closureLocalEntryLabel dflags
| tablesNextToCode dflags = toInfoLbl . closureInfoLabel
| otherwise = toEntryLbl . closureInfoLabel
mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
mkClosureInfoTableLabel id lf_info
mkClosureInfoTableLabel :: DynFlags -> Id -> LambdaFormInfo -> CLabel
mkClosureInfoTableLabel dflags id lf_info
= case lf_info of
LFThunk _ _ upd_flag (SelectorThunk offset) _
-> mkSelectorInfoLabel upd_flag offset
-> mkSelectorInfoLabel dflags upd_flag offset
LFThunk _ _ upd_flag (ApThunk arity) _
-> mkApInfoTableLabel upd_flag arity
-> mkApInfoTableLabel dflags upd_flag arity
LFThunk{} -> std_mk_lbl name cafs
LFReEntrant{} -> std_mk_lbl name cafs
......@@ -825,13 +825,13 @@ thunkEntryLabel dflags thunk_id c _ _
enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
enterApLabel dflags is_updatable arity
| tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity
| otherwise = mkApEntryLabel is_updatable arity
| tablesNextToCode dflags = mkApInfoTableLabel dflags is_updatable arity
| otherwise = mkApEntryLabel dflags is_updatable arity
enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
enterSelectorLabel dflags upd_flag offset
| tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset
| otherwise = mkSelectorEntryLabel upd_flag offset
| tablesNextToCode dflags = mkSelectorInfoLabel dflags upd_flag offset
| otherwise = mkSelectorEntryLabel dflags upd_flag offset
enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
enterIdLabel dflags id c
......
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