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.

4 files changed, 30 insertions, 15 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index d5df2dd1c5..75559edd2e 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/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
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index b247741600..d81bcd4f2e 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/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
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index 449ba4a737..49ea91cfc5 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -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
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 16e54fedc6..97abf78006 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/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