[Git][ghc/ghc][master] X86/DWARF: support no tables-next-to-code and asm-shortcutting (#22792)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Jun 28 11:13:56 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
eebe1658 by Sylvain Henry at 2024-06-28T07:13:26-04:00
X86/DWARF: support no tables-next-to-code and asm-shortcutting (#22792)
- Without TNTC (tables-next-to-code), we must be careful to not
duplicate labels in pprNatCmmDecl. Especially, as a CmmProc is
identified by the label of its entry block (and not of its info
table), we can't reuse the same label to delimit the block end and the
proc end.
- We generate debug infos from Cmm blocks. However, when
asm-shortcutting is enabled, some blocks are dropped at the asm
codegen stage and some labels in the DebugBlocks become missing.
We fix this by filtering the generated debug-info after the asm
codegen to only keep valid infos.
Also add some related documentation.
- - - - -
6 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Platform.hs
- testsuite/tests/regalloc/regalloc_unit_tests.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
-----------------------------------------------------------------------------
--
-- Object-file symbols (called CLabel for historical reasons).
@@ -123,6 +125,7 @@ module GHC.Cmm.CLabel (
toSlowEntryLbl,
toEntryLbl,
toInfoLbl,
+ toProcDelimiterLbl,
-- * Pretty-printing
LabelStyle (..),
@@ -923,6 +926,16 @@ toEntryLbl platform lbl = case lbl of
CmmLabel m ext str CmmRetInfo -> CmmLabel m ext str CmmRet
_ -> pprPanic "toEntryLbl" (pprDebugCLabel platform lbl)
+-- | Generate a CmmProc delimiter label from the actual entry label.
+--
+-- This delimiter label might be the entry label itself, except when the entry
+-- label is a LocalBlockLabel. If we reused the entry label to delimit the proc,
+-- we would generate redundant labels (see #22792)
+toProcDelimiterLbl :: CLabel -> CLabel
+toProcDelimiterLbl lbl = case lbl of
+ LocalBlockLabel {} -> mkAsmTempDerivedLabel lbl (fsLit "_entry")
+ _ -> lbl
+
toInfoLbl :: Platform -> CLabel -> CLabel
toInfoLbl platform lbl = case lbl of
IdLabel n c LocalEntry -> IdLabel n c LocalInfoTable
@@ -1457,10 +1470,17 @@ pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel]
-> tempLabelPrefixOrUnderscore <> pprUniqueAlways u
AsmTempDerivedLabel l suf
- -> asmTempLabelPrefix platform
- <> case l of AsmTempLabel u -> pprUniqueAlways u
- LocalBlockLabel u -> pprUniqueAlways u
- _other -> pprCLabelStyle platform sty l
+ -- we print a derived label, so we just print the parent label
+ -- recursively. However we don't want to print the temp prefix (e.g.
+ -- ".L") twice, so we must explicitely handle these cases.
+ -> let skipTempPrefix = \case
+ AsmTempLabel u -> pprUniqueAlways u
+ AsmTempDerivedLabel l suf -> skipTempPrefix l <> ftext suf
+ LocalBlockLabel u -> pprUniqueAlways u
+ lbl -> pprAsmLabel platform lbl
+ in
+ asmTempLabelPrefix platform
+ <> skipTempPrefix l
<> ftext suf
DynamicLinkerLabel info lbl
=====================================
compiler/GHC/Cmm/DebugBlock.hs
=====================================
@@ -168,11 +168,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
mkBlock top (block, prc)
= DebugBlock { dblProcedure = g_entry graph
, dblLabel = label
- , dblCLabel = case info of
- Just (CmmStaticsRaw infoLbl _) -> infoLbl
- Nothing
- | g_entry graph == label -> entryLbl
- | otherwise -> blockLbl label
+ , dblCLabel = blockLbl label
, dblHasInfoTbl = isJust info
, dblParent = Nothing
, dblTicks = ticks
@@ -181,7 +177,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
, dblBlocks = blocks
, dblUnwind = []
}
- where (CmmProc infos entryLbl _ graph) = prc
+ where (CmmProc infos _entryLbl _ graph) = prc
label = entryLabel block
info = mapLookup label infos
blocks | top = seqList childs childs
@@ -238,8 +234,8 @@ blockContexts decls = Map.map reverse $ foldr walkProc Map.empty decls
insertMulti :: Ord k => k -> a -> Map.Map k [a] -> Map.Map k [a]
insertMulti k v = Map.insertWith (const (v:)) k [v]
-cmmDebugLabels :: (i -> Bool) -> GenCmmGroup d g (ListGraph i) -> [Label]
-cmmDebugLabels isMeta nats = seqList lbls lbls
+cmmDebugLabels :: (BlockId -> Bool) -> (i -> Bool) -> GenCmmGroup d g (ListGraph i) -> [Label]
+cmmDebugLabels is_valid_label isMeta nats = seqList lbls lbls
where -- Find order in which procedures will be generated by the
-- back-end (that actually matters for DWARF generation).
--
@@ -247,7 +243,7 @@ cmmDebugLabels isMeta nats = seqList lbls lbls
-- consist of meta instructions -- we will declare them missing,
-- which will skip debug data generation without messing up the
-- block hierarchy.
- lbls = map blockId $ filter (not . allMeta) $ concatMap getBlocks nats
+ lbls = filter is_valid_label $ map blockId $ filter (not . allMeta) $ concatMap getBlocks nats
getBlocks (CmmProc _ _ _ (ListGraph bs)) = bs
getBlocks _other = []
allMeta (BasicBlock _ instrs) = all isMeta instrs
@@ -256,14 +252,18 @@ cmmDebugLabels isMeta nats = seqList lbls lbls
-- native generated code.
cmmDebugLink :: [Label] -> LabelMap [UnwindPoint]
-> [DebugBlock] -> [DebugBlock]
-cmmDebugLink labels unwindPts blocks = map link blocks
+cmmDebugLink labels unwindPts blocks = mapMaybe link blocks
where blockPos :: LabelMap Int
blockPos = mapFromList $ flip zip [0..] labels
- link block = block { dblPosition = mapLookup (dblLabel block) blockPos
- , dblBlocks = map link (dblBlocks block)
- , dblUnwind = fromMaybe mempty
- $ mapLookup (dblLabel block) unwindPts
- }
+ link block = case mapLookup (dblLabel block) blockPos of
+ -- filter dead blocks: we generated debug infos from Cmm blocks but
+ -- asm-shortcutting may remove some blocks later (#22792)
+ Nothing -> Nothing
+ pos -> Just $ block
+ { dblPosition = pos
+ , dblBlocks = mapMaybe link (dblBlocks block)
+ , dblUnwind = fromMaybe mempty $ mapLookup (dblLabel block) unwindPts
+ }
-- | Converts debug blocks into a label map for easier lookups
debugToMap :: [DebugBlock] -> LabelMap DebugBlock
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -362,7 +362,7 @@ cmmNativeGens logger config ncgImpl h dbgMap = go
go us (cmm : cmms) ngs count = do
let fileIds = ngs_dwarfFiles ngs
- (us', fileIds', native, imports, colorStats, linearStats, unwinds)
+ (us', fileIds', native, imports, colorStats, linearStats, unwinds, mcfg)
<- {-# SCC "cmmNativeGen" #-}
cmmNativeGen logger ncgImpl us fileIds dbgMap
cmm count
@@ -390,7 +390,13 @@ cmmNativeGens logger config ncgImpl h dbgMap = go
{-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pprAsmLabel platform) imports) ()
let !labels' = if ncgDwarfEnabled config
- then cmmDebugLabels isMetaInstr native else []
+ then cmmDebugLabels is_valid_label isMetaInstr native else []
+ is_valid_label
+ -- filter dead labels: asm-shortcutting may remove some blocks
+ -- (#22792)
+ | Just cfg <- mcfg = hasNode cfg
+ | otherwise = const True
+
!natives' = if logHasDumpFlag logger Opt_D_dump_asm_stats
then native : ngs_natives ngs else []
@@ -436,6 +442,7 @@ cmmNativeGen
, Maybe [Color.RegAllocStats statics instr] -- stats for the coloring register allocator
, Maybe [Linear.RegAllocStats] -- stats for the linear register allocators
, LabelMap [UnwindPoint] -- unwinding information for blocks
+ , Maybe CFG -- final CFG
)
cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
@@ -673,7 +680,9 @@ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
, lastMinuteImports ++ imports
, ppr_raStatsColor
, ppr_raStatsLinear
- , unwinds )
+ , unwinds
+ , optimizedCFG
+ )
maybeDumpCfg :: Logger -> Maybe CFG -> String -> SDoc -> IO ()
maybeDumpCfg _logger Nothing _ _ = return ()
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -71,45 +71,74 @@ pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics)
pprNatCmmDecl config (CmmData section dats) =
pprSectionAlign config section $$ pprDatas config dats
-pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
- let platform = ncgPlatform config in
- case topInfoTable proc of
- Nothing ->
- -- special case for code without info table:
- pprSectionAlign config (Section Text lbl) $$
- pprProcAlignment config $$
- pprProcLabel config lbl $$
- pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
- vcat (map (pprBasicBlock config top_info) blocks) $$
- ppWhen (ncgDwarfEnabled config) (line (pprBlockEndLabel platform lbl) $$ line (pprProcEndLabel platform lbl)) $$
- pprSizeDecl platform lbl
-
- Just (CmmStaticsRaw info_lbl _) ->
- pprSectionAlign config (Section Text info_lbl) $$
- pprProcAlignment config $$
- pprProcLabel config lbl $$
- (if platformHasSubsectionsViaSymbols platform
- then line (pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> colon)
- else empty) $$
- vcat (map (pprBasicBlock config top_info) blocks) $$
- ppWhen (ncgDwarfEnabled config) (line (pprProcEndLabel platform info_lbl)) $$
- -- above: Even the first block gets a label, because with branch-chain
+pprNatCmmDecl config proc@(CmmProc top_info entry_lbl _ (ListGraph blocks)) =
+ let platform = ncgPlatform config
+ top_info_table = topInfoTable proc
+ -- we need a label to delimit the proc code (e.g. in debug builds). When
+ -- we have an info table, we reuse the info table label. Otherwise we make
+ -- a fresh "entry" label from the label of the entry block. We can't reuse
+ -- the entry block label as-is, otherwise we get redundant labels:
+ -- delimiters for the entry block and for the whole proc are the same (see
+ -- #22792).
+ proc_lbl = case top_info_table of
+ Just (CmmStaticsRaw info_lbl _) -> info_lbl
+ Nothing -> toProcDelimiterLbl entry_lbl
+
+ -- handle subsections_via_symbols when enabled and when we have an
+ -- info-table to link to. See Note [Subsections Via Symbols]
+ (sub_via_sym_label,sub_via_sym_offset)
+ | platformHasSubsectionsViaSymbols platform
+ , Just (CmmStaticsRaw info_lbl _) <- top_info_table
+ , info_dsp_lbl <- pprAsmLabel platform (mkDeadStripPreventer info_lbl)
+ = ( line (info_dsp_lbl <> colon)
+ , line $ text "\t.long " <+> pprAsmLabel platform info_lbl <+> char '-' <+> info_dsp_lbl
+ )
+ | otherwise = (empty,empty)
+
+ in vcat
+ [ -- section directive. Requires proc_lbl when split-section is enabled to
+ -- use as a subsection name.
+ pprSectionAlign config (Section Text proc_lbl)
+
+ -- section alignment. Note that when there is an info table, we align the
+ -- info table and not the entry code!
+ , pprProcAlignment config
+
+ -- Special label when ncgExposeInternalSymbols is enabled. See Note
+ -- [Internal proc labels] in GHC.Cmm.Label
+ , pprExposedInternalProcLabel config entry_lbl
+
+ -- Subsections-via-symbols label. See Note [Subsections Via Symbols]
+ , sub_via_sym_label
+
+ -- We need to print a label indicating the beginning of the entry code:
+ -- 1. Without tables-next-to-code, we just print it here
+ -- 2. With tables-next-to-code, the proc_lbl is the info-table label and it
+ -- will be printed in pprBasicBlock after the info-table itself.
+ , case top_info_table of
+ Nothing -> pprLabel platform proc_lbl
+ Just _ -> empty
+
+ -- Proc's basic blocks
+ , vcat (map (pprBasicBlock config top_info) blocks)
+ -- Note that even the first block gets a label, because with branch-chain
-- elimination, it might be the target of a goto.
- (if platformHasSubsectionsViaSymbols platform
- then -- See Note [Subsections Via Symbols]
- line
- $ text "\t.long "
- <+> pprAsmLabel platform info_lbl
- <+> char '-'
- <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
- else empty) $$
- pprSizeDecl platform info_lbl
+
+ -- Print the proc end label when debugging is enabled
+ , ppWhen (ncgDwarfEnabled config) $ line (pprProcEndLabel platform proc_lbl)
+
+ -- Subsections-via-symbols offset. See Note [Subsections Via Symbols]
+ , sub_via_sym_offset
+
+ -- ELF .size directive (size of the entry code function)
+ , pprSizeDecl platform proc_lbl
+ ]
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> SDoc #-}
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
-- | Output an internal proc label. See Note [Internal proc labels] in CLabel.
-pprProcLabel :: IsDoc doc => NCGConfig -> CLabel -> doc
-pprProcLabel config lbl
+pprExposedInternalProcLabel :: IsDoc doc => NCGConfig -> CLabel -> doc
+pprExposedInternalProcLabel config lbl
| ncgExposeInternalSymbols config
, Just lbl' <- ppInternalProcLabel (ncgThisModule config) lbl
= line (lbl' <> colon)
@@ -118,8 +147,7 @@ pprProcLabel config lbl
pprProcEndLabel :: IsLine doc => Platform -> CLabel -- ^ Procedure name
-> doc
-pprProcEndLabel platform lbl =
- pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon
+pprProcEndLabel platform lbl = pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon
pprBlockEndLabel :: IsLine doc => Platform -> CLabel -- ^ Block name
-> doc
@@ -136,16 +164,16 @@ pprSizeDecl platform lbl
pprBasicBlock :: IsDoc doc => NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> doc
pprBasicBlock config info_env (BasicBlock blockid instrs)
= maybe_infotable $
- pprLabel platform asmLbl $$
+ pprLabel platform block_label $$
vcat (map (pprInstr platform) instrs) $$
ppWhen (ncgDwarfEnabled config) (
-- Emit both end labels since this may end up being a standalone
-- top-level block
- line (pprBlockEndLabel platform asmLbl
- <> pprProcEndLabel platform asmLbl)
+ line (pprBlockEndLabel platform block_label) $$
+ line (pprProcEndLabel platform block_label)
)
where
- asmLbl = blockLbl blockid
+ block_label = blockLbl blockid
platform = ncgPlatform config
maybe_infotable c = case mapLookup blockid info_env of
Nothing -> c
@@ -155,7 +183,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
vcat (map (pprData config) info) $$
pprLabel platform infoLbl $$
c $$
- ppWhen (ncgDwarfEnabled config) (line (pprAsmLabel platform (mkAsmTempEndLabel infoLbl) <> colon))
+ ppWhen (ncgDwarfEnabled config) (line (pprBlockEndLabel platform infoLbl))
-- Make sure the info table has the right .loc for the block
-- coming right after it. See Note [Info Offset]
=====================================
compiler/GHC/Platform.hs
=====================================
@@ -75,6 +75,9 @@ data Platform = Platform
, platformHasGnuNonexecStack :: !Bool
, platformHasIdentDirective :: !Bool
, platformHasSubsectionsViaSymbols :: !Bool
+ -- ^ Enable Darwin .subsections_via_symbols directive
+ --
+ -- See Note [Subsections Via Symbols] in GHC.CmmToAsm.X86.Ppr
, platformIsCrossCompiling :: !Bool
, platformLeadingUnderscore :: !Bool -- ^ Symbols need underscore prefix
, platformTablesNextToCode :: !Bool
=====================================
testsuite/tests/regalloc/regalloc_unit_tests.hs
=====================================
@@ -155,7 +155,7 @@ compileCmmForRegAllocStats logger home_unit dflags cmmFile ncgImplF us = do
mapM (\ (count, thisCmm) ->
cmmNativeGen logger ncgImpl
usb dwarfFileIds dbgMap thisCmm count >>=
- (\(_, _, _, _, colorStats, linearStats, _) ->
+ (\(_, _, _, _, colorStats, linearStats, _, _) ->
-- scrub unneeded output from cmmNativeGen
return (colorStats, linearStats)))
$ zip [0.. (length collectedCmms)] collectedCmms
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eebe1658cc457ac5c89791ae988193f1cf09ff0b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eebe1658cc457ac5c89791ae988193f1cf09ff0b
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/20240628/0f709032/attachment-0001.html>
More information about the ghc-commits
mailing list