codeGen: Produce local symbols for module-internal functions

It turns out that some important native debugging/profiling tools (e.g.
perf) rely only on symbol tables for function name resolution (as
opposed to using DWARF DIEs). However, previously GHC would emit
temporary symbols (e.g. `.La42b`) to identify module-internal
entities. Such symbols are dropped during linking and therefore not
visible to runtime tools (in addition to having rather un-helpful unique
names). For instance, `perf report` would often end up attributing all
cost to the libc `frame_dummy` symbol since Haskell code was no covered
by any proper symbol (see #17605).

We now rather follow the model of C compilers and emit
descriptively-named local symbols for module internal things. Since this
will increase object file size this behavior can be disabled with the
`-fno-expose-internal-symbols` flag.

With this `perf record` can finally be used against Haskell executables.
Even more, with `-g3` `perf annotate` provides inline source code.

3 files changed, 15 insertions, 2 deletions

diff --git a/compiler/GHC/CmmToAsm/Config.hs b/compiler/GHC/CmmToAsm/Config.hs
index b3dd1df1ca..141f1168be 100644
--- a/compiler/GHC/CmmToAsm/Config.hs
+++ b/compiler/GHC/CmmToAsm/Config.hs
@@ -18,8 +18,7 @@ import GHC.Utils.Outputable
 data NCGConfig = NCGConfig
    { ncgPlatform              :: !Platform        -- ^ Target platform
    , ncgAsmContext            :: !SDocContext     -- ^ Context for ASM code generation
-   , ncgThisModule            :: !Module          -- ^ The name of the module we are currently compiling (for generating debug information)
-                                                  -- See Note [Internal proc labels] in CLabel.
+   , ncgThisModule            :: !Module          -- ^ The name of the module we are currently compiling
    , ncgProcAlignment         :: !(Maybe Int)     -- ^ Mandatory proc alignment
    , ncgExternalDynamicRefs   :: !Bool            -- ^ Generate code to link against dynamic libraries
    , ncgPIC                   :: !Bool            -- ^ Enable Position-Independent Code
@@ -40,6 +39,7 @@ data NCGConfig = NCGConfig
    , ncgDwarfEnabled          :: !Bool            -- ^ Enable Dwarf generation
    , ncgDwarfUnwindings       :: !Bool            -- ^ Enable unwindings
    , ncgDwarfStripBlockInfo   :: !Bool            -- ^ Strip out block information from generated Dwarf
+   , ncgExposeInternalSymbols :: !Bool            -- ^ Expose symbol table entries for internal symbols
    }
 
 -- | Return Word size
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index 5f306bf8d6..8fb834ec7a 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -80,6 +80,8 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     canShortcut               :: instr -> Maybe jumpDest,
     shortcutStatics           :: (BlockId -> Maybe jumpDest) -> statics -> statics,
     shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
+    -- | 'Module' is only for printing internal labels. See Note [Internal proc
+    -- labels] in CLabel.
     pprNatCmmDecl             :: NatCmmDecl statics instr -> SDoc,
     maxSpillSlots             :: Int,
     allocatableRegs           :: [RealReg],
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index b9fe4c0260..16e54fedc6 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -90,6 +90,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
         -- 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) $$
         (if ncgDwarfEnabled config
@@ -99,6 +100,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
     Just (CmmStaticsRaw info_lbl _) ->
       pprSectionAlign config (Section Text info_lbl) $$
       pprProcAlignment config $$
+      pprProcLabel config lbl $$
       (if platformHasSubsectionsViaSymbols platform
           then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
           else empty) $$
@@ -114,6 +116,15 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
        else empty) $$
       pprSizeDecl platform info_lbl
 
+-- | Output an internal proc label. See Note [Internal proc labels] in CLabel.
+pprProcLabel :: NCGConfig -> CLabel -> SDoc
+pprProcLabel config lbl
+  | ncgExposeInternalSymbols config
+  , Just lbl' <- ppInternalProcLabel (ncgThisModule config) lbl
+  = lbl' <> char ':'
+  | otherwise
+  = empty
+
 -- | Output the ELF .size directive.
 pprSizeDecl :: Platform -> CLabel -> SDoc
 pprSizeDecl platform lbl