[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: X86/DWARF: support no tables-next-to-code and asm-shortcutting (#22792)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Jun 28 07:43:28 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
61efbc5f by Sylvain Henry at 2024-06-28T03:43:06-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.
- - - - -
d951750e by Sylvain Henry at 2024-06-28T03:43:12-04:00
PPC NCG: handle JMP to ForeignLabels (#23969)
- - - - -
2500f0a7 by Sylvain Henry at 2024-06-28T03:43:12-04:00
PPC NCG: support loading 64-bit value on 32-bit arch (#23969)
- - - - -
ae231585 by Sylvain Henry at 2024-06-28T03:43:14-04:00
Fix warnings in genapply
- - - - -
73670c1e by Matthew Pickering at 2024-06-28T03:43:15-04:00
libraries: Update os-string to 2.0.4
This updates the os-string submodule to 2.0.4 which removes the usage of
`TemplateHaskell` pragma.
- - - - -
10 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Platform.hs
- libraries/os-string
- testsuite/tests/regalloc/regalloc_unit_tests.hs
- utils/genapply/Main.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/PPC/CodeGen.hs
=====================================
@@ -449,6 +449,7 @@ getRegister' _ platform (CmmMachOp (MO_SS_Conv W64 W32) [x])
getRegister' _ platform (CmmLoad mem pk _)
| not (isWord64 pk) = do
Amode addr addr_code <- getAmode D mem
+ let format = cmmTypeFormat pk
let code dst = assert ((targetClassOfReg platform dst == RcDouble) == isFloatType pk) $
addr_code `snocOL` LD format dst addr
return (Any format code)
@@ -457,7 +458,12 @@ getRegister' _ platform (CmmLoad mem pk _)
let code dst = addr_code `snocOL` LD II64 dst addr
return (Any II64 code)
- where format = cmmTypeFormat pk
+ | otherwise = do -- 32-bit arch & 64-bit load
+ (hi_addr, lo_addr, addr_code) <- getI64Amodes mem
+ let code dst = addr_code
+ `snocOL` LD II32 dst lo_addr
+ `snocOL` LD II32 (getHiVRegFromLo dst) hi_addr
+ return (Any II64 code)
-- catch simple cases of zero- or sign-extended load
getRegister' _ _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _ _]) = do
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -586,8 +586,12 @@ pprInstr platform instr = case instr of
Just False -> char '+'
JMP lbl _
- -- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
- | isForeignLabel lbl -> pprPanic "PPC.Ppr.pprInstr: JMP to ForeignLabel" (pprDebugCLabel platform lbl)
+ | OSAIX <- platformOS platform ->
+ line $ hcat [ -- an alias for b that takes a CLabel
+ text "\tb.\t", -- add the ".", cf Note [AIX function descriptors and entry-code addresses]
+ pprAsmLabel platform lbl
+ ]
+
| otherwise ->
line $ hcat [ -- an alias for b that takes a CLabel
text "\tb\t",
@@ -611,6 +615,8 @@ pprInstr platform instr = case instr of
BL lbl _
-> case platformOS platform of
OSAIX ->
+ -- Note [AIX function descriptors and entry-code addresses]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- On AIX, "printf" denotes a function-descriptor (for use
-- by function pointers), whereas the actual entry-code
-- address is denoted by the dot-prefixed ".printf" label.
=====================================
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
=====================================
libraries/os-string
=====================================
@@ -1 +1 @@
-Subproject commit e1dd3bcfab56a6616c73ee9220de425d55545bc8
+Subproject commit 6d31aafde2f7b8c3050ffee7dd9f658225cfd1a4
=====================================
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
=====================================
utils/genapply/Main.hs
=====================================
@@ -15,9 +15,7 @@ import Text.PrettyPrint
import Data.Word
import Data.Bits
import Data.List ( intersperse, nub, sort )
-import System.Exit
import System.Environment
-import System.IO
import Control.Arrow ((***))
{-
@@ -78,8 +76,10 @@ data TargetInfo = TargetInfo
parseTargetInfo :: FilePath -> IO TargetInfo
parseTargetInfo path = do
header <- readFile path
- let tups = [ (k, read v) | '/':'/':' ':l <- lines header, let [k, v] = words l ]
- tups_get k = v where Just v = lookup k tups
+ let tups = [ (k, read v) | '/':'/':' ':l <- lines header, [k, v] <- [words l] ]
+ tups_get k = case lookup k tups of
+ Nothing -> error "genapply.parseTargetInfo: Missing key"
+ Just v -> v
tag_bits = tups_get "TAG_BITS"
pure TargetInfo {
maxRealVanillaReg = tups_get "MAX_Real_Vanilla_REG",
@@ -442,7 +442,7 @@ genMkPAP targetInfo at TargetInfo {..} macro jump live _ticker disamb
adj_reg_locs = [ (reg, off - adj + 1) |
(reg,off) <- extra_reg_locs ]
adj = case extra_reg_locs of
- (reg, fst_off):_ -> fst_off
+ (_reg, fst_off):_ -> fst_off
[] -> error "Impossible: genapply.hs : No extra register locations"
size = snd (last adj_reg_locs) + 1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1804bedcfec40ffe3b2839332b5dc14aaaf18c1...73670c1eaddc27c45e38cf211730fb1b556d56fa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1804bedcfec40ffe3b2839332b5dc14aaaf18c1...73670c1eaddc27c45e38cf211730fb1b556d56fa
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/8eadf91b/attachment-0001.html>
More information about the ghc-commits
mailing list