[Git][ghc/ghc][master] 4 commits: nativeGen/dwarf: Fix procedure end addresses
Marge Bot
gitlab at gitlab.haskell.org
Sun Nov 15 08:35:53 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00
nativeGen/dwarf: Fix procedure end addresses
Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF
information would claim that procedures (represented with a
`DW_TAG_subprogram` DIE) would only span the range covered by their entry
block. This omitted all of the continuation blocks (represented by
`DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing
a end-of-procedure label and using this as the `DW_AT_high_pc` of
procedure `DW_TAG_subprogram` DIEs
Fixes #17605.
- - - - -
1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00
nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3
Standard debugging tools don't know how to understand these so let's not
produce them unless asked.
- - - - -
ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00
nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage
- - - - -
a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00
gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27
- - - - -
9 changed files:
- .gitlab-ci.yml
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/Config.hs
- compiler/GHC/CmmToAsm/Dwarf.hs
- compiler/GHC/CmmToAsm/Dwarf/Constants.hs
- compiler/GHC/CmmToAsm/Dwarf/Types.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- docs/users_guide/debug-info.rst
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -742,6 +742,15 @@ release-x86_64-linux-deb10:
<<: *release
extends: .build-x86_64-linux-deb10
+release-x86_64-linux-deb10-dwarf:
+ <<: *release
+ extends: .build-x86_64-linux-deb10
+ variables:
+ CONFIGURE_ARGS: "--enable-dwarf-unwind"
+ BUILD_FLAVOUR: dwarf
+ TEST_ENV: "x86_64-linux-deb10-dwarf"
+ BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb10-linux-dwarf.tar.xz"
+
#################################
# x86_64-linux-ubuntu 20.04
#################################
@@ -857,7 +866,7 @@ release-x86_64-linux-centos7:
# x86_64-linux-fedora27
#################################
-validate-x86_64-linux-fedora27:
+.build-x86_64-linux-fedora27:
extends: .validate-linux
stage: full-build
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora27:$DOCKER_REV"
@@ -866,7 +875,6 @@ validate-x86_64-linux-fedora27:
LLC: /bin/false
OPT: /bin/false
TEST_ENV: "x86_64-linux-fedora27"
- BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-fedora27-linux.tar.xz"
cache:
key: linux-x86_64-fedora27
artifacts:
@@ -875,6 +883,20 @@ validate-x86_64-linux-fedora27:
# longer.
expire_in: 8 week
+validate-x86_64-linux-fedora27:
+ extends: .build-x86_64-linux-fedora27
+ variables:
+ BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-fedora27-linux.tar.xz"
+
+release-x86_64-linux-fedora27-dwarf:
+ <<: *release
+ extends: .build-x86_64-linux-fedora27
+ variables:
+ CONFIGURE_ARGS: "--enable-dwarf-unwind"
+ BUILD_FLAVOUR: dwarf
+ BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-fedora27-linux-dwarf.tar.xz"
+ TEST_ENV: "x86_64-linux-fedora27-dwarf"
+
############################################################
# Validation via Pipelines (Windows)
############################################################
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -44,6 +44,7 @@ module GHC.Cmm.CLabel (
mkAsmTempLabel,
mkAsmTempDerivedLabel,
mkAsmTempEndLabel,
+ mkAsmTempProcEndLabel,
mkAsmTempDieLabel,
mkDirty_MUT_VAR_Label,
@@ -755,6 +756,10 @@ mkAsmTempDerivedLabel = AsmTempDerivedLabel
mkAsmTempEndLabel :: CLabel -> CLabel
mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
+-- | A label indicating the end of a procedure.
+mkAsmTempProcEndLabel :: CLabel -> CLabel
+mkAsmTempProcEndLabel l = mkAsmTempDerivedLabel l (fsLit "_proc_end")
+
-- | Construct a label for a DWARF Debug Information Entity (DIE)
-- describing another symbol.
mkAsmTempDieLabel :: CLabel -> CLabel
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -1187,9 +1187,10 @@ initNCGConfig dflags this_mod = NCGConfig
ArchX86 -> v
_ -> Nothing
- , ncgDwarfEnabled = debugLevel dflags > 0
+ , ncgDwarfEnabled = debugLevel dflags > 0
, ncgDwarfUnwindings = debugLevel dflags >= 1
- , ncgDwarfStripBlockInfo = debugLevel dflags < 2 -- We strip out block information when running with -g0 or -g1.
, ncgExposeInternalSymbols = gopt Opt_ExposeInternalSymbols dflags
+ , ncgDwarfStripBlockInfo = debugLevel dflags < 2 -- We strip out block information when running with -g0 or -g1.
+ , ncgDwarfSourceNotes = debugLevel dflags >= 3 -- We produce GHC-specific source-note DIEs only with -g3
}
=====================================
compiler/GHC/CmmToAsm/Config.hs
=====================================
@@ -40,6 +40,7 @@ data NCGConfig = NCGConfig
, ncgDwarfUnwindings :: !Bool -- ^ Enable unwindings
, ncgDwarfStripBlockInfo :: !Bool -- ^ Strip out block information from generated Dwarf
, ncgExposeInternalSymbols :: !Bool -- ^ Expose symbol table entries for internal symbols
+ , ncgDwarfSourceNotes :: !Bool -- ^ Enable GHC-specific source note DIEs
}
-- | Return Word size
=====================================
compiler/GHC/CmmToAsm/Dwarf.hs
=====================================
@@ -45,7 +45,7 @@ dwarfGen config modLoc us blocks = do
| otherwise = dbg
compPath <- getCurrentDirectory
let lowLabel = dblCLabel $ head procs
- highLabel = mkAsmTempEndLabel $ dblCLabel $ last procs
+ highLabel = mkAsmTempProcEndLabel $ dblCLabel $ last procs
dwarfUnit = DwarfCompileUnit
{ dwChildren = map (procToDwarf config) (map stripBlocks procs)
, dwName = fromMaybe "" (ml_hs_file modLoc)
@@ -99,10 +99,10 @@ dwarfGen config modLoc us blocks = do
-- scattered in the final binary. Without split sections, we could make a
-- single arange based on the first/last proc.
mkDwarfARange :: DebugBlock -> DwarfARange
-mkDwarfARange proc = DwarfARange start end
+mkDwarfARange proc = DwarfARange lbl end
where
- start = dblCLabel proc
- end = mkAsmTempEndLabel start
+ lbl = dblCLabel proc
+ end = mkAsmTempProcEndLabel lbl
-- | Header for a compilation unit, establishing global format
-- parameters
@@ -176,7 +176,7 @@ parent, B.
-- | Generate DWARF info for a procedure debug block
procToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
procToDwarf config prc
- = DwarfSubprogram { dwChildren = map blockToDwarf (dblBlocks prc)
+ = DwarfSubprogram { dwChildren = map (blockToDwarf config) (dblBlocks prc)
, dwName = case dblSourceTick prc of
Just s at SourceNote{} -> sourceName s
_otherwise -> show (dblLabel prc)
@@ -195,14 +195,17 @@ procToDwarf config prc
goodParent _ = True
-- | Generate DWARF info for a block
-blockToDwarf :: DebugBlock -> DwarfInfo
-blockToDwarf blk
- = DwarfBlock { dwChildren = concatMap tickToDwarf (dblTicks blk)
- ++ map blockToDwarf (dblBlocks blk)
+blockToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
+blockToDwarf config blk
+ = DwarfBlock { dwChildren = map (blockToDwarf config) (dblBlocks blk) ++ srcNotes
, dwLabel = dblCLabel blk
, dwMarker = marker
}
where
+ srcNotes
+ | ncgDwarfSourceNotes config = concatMap tickToDwarf (dblTicks blk)
+ | otherwise = []
+
marker
| Just _ <- dblPosition blk = Just $ mkAsmTempLabel $ dblLabel blk
| otherwise = Nothing -- block was optimized out
=====================================
compiler/GHC/CmmToAsm/Dwarf/Constants.hs
=====================================
@@ -48,7 +48,7 @@ dW_TAG_ghc_src_note = 0x5b00
-- * Dwarf attributes
dW_AT_name, dW_AT_stmt_list, dW_AT_low_pc, dW_AT_high_pc, dW_AT_language,
dW_AT_comp_dir, dW_AT_producer, dW_AT_external, dW_AT_frame_base,
- dW_AT_use_UTF8, dW_AT_MIPS_linkage_name :: Word
+ dW_AT_use_UTF8, dW_AT_linkage_name :: Word
dW_AT_name = 0x03
dW_AT_stmt_list = 0x10
dW_AT_low_pc = 0x11
@@ -59,7 +59,7 @@ dW_AT_producer = 0x25
dW_AT_external = 0x3f
dW_AT_frame_base = 0x40
dW_AT_use_UTF8 = 0x53
-dW_AT_MIPS_linkage_name = 0x2007
+dW_AT_linkage_name = 0x6e
-- * Custom DWARF attributes
-- Chosen a more or less random section of the vendor-extensible region
=====================================
compiler/GHC/CmmToAsm/Dwarf/Types.hs
=====================================
@@ -105,7 +105,7 @@ pprAbbrevDecls platform haveDebugLine =
-- DwAbbrSubprogramWithParent
subprogramAttrs =
[ (dW_AT_name, dW_FORM_string)
- , (dW_AT_MIPS_linkage_name, dW_FORM_string)
+ , (dW_AT_linkage_name, dW_FORM_string)
, (dW_AT_external, dW_FORM_flag)
, (dW_AT_low_pc, dW_FORM_addr)
, (dW_AT_high_pc, dW_FORM_addr)
@@ -190,7 +190,7 @@ pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) =
$$ pprLabelString platform label
$$ pprFlag (externallyVisibleCLabel label)
$$ pprWord platform (pdoc platform label)
- $$ pprWord platform (pdoc platform $ mkAsmTempEndLabel label)
+ $$ pprWord platform (pdoc platform $ mkAsmTempProcEndLabel label)
$$ pprByte 1
$$ pprByte dW_OP_call_frame_cfa
$$ parentValue
@@ -354,7 +354,7 @@ pprFrameProc :: Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> SDoc
pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks)
= let fdeLabel = mkAsmTempDerivedLabel procLbl (fsLit "_fde")
fdeEndLabel = mkAsmTempDerivedLabel procLbl (fsLit "_fde_end")
- procEnd = mkAsmTempEndLabel procLbl
+ procEnd = mkAsmTempProcEndLabel procLbl
ifInfo str = if hasInfo then text str else empty
-- see [Note: Info Offset]
in vcat [ whenPprDebug $ text "# Unwinding for" <+> pdoc platform procLbl <> colon
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -93,8 +93,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
pprProcLabel config lbl $$
pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
vcat (map (pprBasicBlock config top_info) blocks) $$
- (if ncgDwarfEnabled config
- then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
+ ppWhen (ncgDwarfEnabled config) (pprBlockEndLabel platform lbl $$ pprProcEndLabel platform lbl) $$
pprSizeDecl platform lbl
Just (CmmStaticsRaw info_lbl _) ->
@@ -105,6 +104,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
else empty) $$
vcat (map (pprBasicBlock config top_info) blocks) $$
+ ppWhen (ncgDwarfEnabled config) (pprProcEndLabel platform info_lbl) $$
-- above: Even the first block gets a label, because with branch-chain
-- elimination, it might be the target of a goto.
(if platformHasSubsectionsViaSymbols platform
@@ -125,6 +125,16 @@ pprProcLabel config lbl
| otherwise
= empty
+pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
+ -> SDoc
+pprProcEndLabel platform lbl =
+ pdoc platform (mkAsmTempProcEndLabel lbl) <> char ':'
+
+pprBlockEndLabel :: Platform -> CLabel -- ^ Block name
+ -> SDoc
+pprBlockEndLabel platform lbl =
+ pdoc platform (mkAsmTempEndLabel lbl) <> char ':'
+
-- | Output the ELF .size directive.
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl platform lbl
@@ -137,9 +147,11 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
= maybe_infotable $
pprLabel platform asmLbl $$
vcat (map (pprInstr platform) instrs) $$
- (if ncgDwarfEnabled config
- then pdoc (ncgPlatform config) (mkAsmTempEndLabel asmLbl) <> char ':'
- else empty
+ ppWhen (ncgDwarfEnabled config) (
+ -- Emit both end labels since this may end up being a standalone
+ -- top-level block
+ pprBlockEndLabel platform asmLbl
+ <> pprProcEndLabel platform asmLbl
)
where
asmLbl = blockLbl blockid
@@ -152,10 +164,8 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
vcat (map (pprData config) info) $$
pprLabel platform infoLbl $$
c $$
- (if ncgDwarfEnabled config
- then pdoc platform (mkAsmTempEndLabel infoLbl) <> char ':'
- else empty
- )
+ ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel infoLbl) <> char ':')
+
-- Make sure the info table has the right .loc for the block
-- coming right after it. See [Note: Info Offset]
infoTableLoc = case instrs of
=====================================
docs/users_guide/debug-info.rst
=====================================
@@ -24,7 +24,9 @@ useable by most UNIX debugging tools.
* ``-g1``: produces stack unwinding records for top-level functions (sufficient for basic backtraces)
* ``-g2``: produces stack unwinding records for top-level functions as well
as inner blocks (allowing more precise backtraces than with ``-g1``).
- * ``-g3``: same as ``-g2``.
+ * ``-g3``: produces GHC-specific DWARF information for use by more
+ sophisticated Haskell-aware debugging tools (see :ref:`dwarf-dies` for
+ details)
If ⟨n⟩ is omitted, level 2 is assumed.
@@ -266,6 +268,7 @@ In particular GHC produces the following DWARF sections,
``.debug_arange``
Address range information necessary for efficient lookup in debug information.
+.. _dwarf_dies:
Debugging information entities
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24a86f09da3426cf1006004bc45d312725280dd5...a2539650cc9c6606c6b50dd5dd96caa0209b408c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24a86f09da3426cf1006004bc45d312725280dd5...a2539650cc9c6606c6b50dd5dd96caa0209b408c
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/20201115/2314bb6d/attachment-0001.html>
More information about the ghc-commits
mailing list