[Git][ghc/ghc][master] Move CLabel assertions into smart constructors (#17957)
Marge Bot
gitlab at gitlab.haskell.org
Wed Jun 17 19:33:34 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00
Move CLabel assertions into smart constructors (#17957)
It avoids using DynFlags in the Outputable instance of Clabel to check
assertions at pretty-printing time.
- - - - -
2 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/StgToCmm/Closure.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -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
=====================================
compiler/GHC/StgToCmm/Closure.hs
=====================================
@@ -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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb8115a8c4cbc842b66798480fefc7ab64d31931
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb8115a8c4cbc842b66798480fefc7ab64d31931
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200617/906ee188/attachment-0001.html>
More information about the ghc-commits
mailing list