Mark code related symbols as @function not @object

Summary:
This diff is a part of the bigger project which goal is to improve
common profiling tools support (perf) for GHC binaries.

A similar job was already done and reverted in the past:
 * https://phabricator.haskell.org/rGHCb1f453e16f0ce11a2ab18cc4c350bdcbd36299a6
 * https://phabricator.haskell.org/rGHCf1f3c4f50650110ad0f700d6566a44c515b0548f

Reasoning:

`Perf` and similar tools build in memory symbol table from the .symtab
section of the ELF file to display human-readable function names instead
of the addresses in the output. `Perf` uses only two types of symbols:
`@function` and `@notype` but GHC is not capable to produce any
`@function` symbols so the `perf` output is pretty useless (All the
haskell symbols that you can see in `perf` now are `@notype` internal
symbols extracted by mistake/hack).

The changes:
 * mark code related symbols as @function
 * small hack to mark InfoTable symbols as code if TABLES_NEXT_TO_CODE is true

Limitations:
 * The perf symbolization support is not complete after this patch but
   I'm working on the second patch.
 * Constructor symbols are not supported. To fix that we can issue extra
   local symbols which mark code sections as code and will be only used
   for debug.

Test Plan:
tests
any additional ideas?

Perf output on stock ghc 8.4.1:
```
     9.78%  FibbSlow  FibbSlow            [.] ckY_info
     9.59%  FibbSlow  FibbSlow            [.] cjqd_info
     7.17%  FibbSlow  FibbSlow            [.] c3sg_info
     6.62%  FibbSlow  FibbSlow            [.] c1X_info
     5.32%  FibbSlow  FibbSlow            [.] cjsX_info
     4.18%  FibbSlow  FibbSlow            [.] s3rN_info
     3.82%  FibbSlow  FibbSlow            [.] c2m_info
     3.68%  FibbSlow  FibbSlow            [.] cjlJ_info
     3.26%  FibbSlow  FibbSlow            [.] c3sb_info
     3.19%  FibbSlow  FibbSlow            [.] cjPQ_info
     3.05%  FibbSlow  FibbSlow            [.] cjQd_info
     2.97%  FibbSlow  FibbSlow            [.] cjAB_info
     2.78%  FibbSlow  FibbSlow            [.] cjzP_info
     2.40%  FibbSlow  FibbSlow            [.] cjOS_info
     2.38%  FibbSlow  FibbSlow            [.] s3rK_info
     2.27%  FibbSlow  FibbSlow            [.] cjq0_info
     2.18%  FibbSlow  FibbSlow            [.] cKQ_info
     2.13%  FibbSlow  FibbSlow            [.] cjSl_info
     1.99%  FibbSlow  FibbSlow            [.] s3rL_info
     1.98%  FibbSlow  FibbSlow            [.] c2cC_info
     1.80%  FibbSlow  FibbSlow            [.] s3rO_info
     1.37%  FibbSlow  FibbSlow            [.] c2f2_info
...
```

Perf output on patched ghc:
```
     7.97%  FibbSlow  FibbSlow            [.] c3rM_info
     6.75%  FibbSlow  FibbSlow            [.] 0x000000000032cfa8
     6.63%  FibbSlow  FibbSlow            [.] cifA_info
     4.98%  FibbSlow  FibbSlow            [.] integerzmgmp_GHCziIntegerziType_eqIntegerzh_info
     4.55%  FibbSlow  FibbSlow            [.] chXn_info
     4.52%  FibbSlow  FibbSlow            [.] c3rH_info
     4.45%  FibbSlow  FibbSlow            [.] chZB_info
     4.04%  FibbSlow  FibbSlow            [.] Main_fibbzuslow_info
     4.03%  FibbSlow  FibbSlow            [.] stg_ap_0_fast
     3.76%  FibbSlow  FibbSlow            [.] chXA_info
     3.67%  FibbSlow  FibbSlow            [.] cifu_info
     3.25%  FibbSlow  FibbSlow            [.] ci4r_info
     2.64%  FibbSlow  FibbSlow            [.] s3rf_info
     2.42%  FibbSlow  FibbSlow            [.] s3rg_info
     2.39%  FibbSlow  FibbSlow            [.] integerzmgmp_GHCziIntegerziType_eqInteger_info
     2.25%  FibbSlow  FibbSlow            [.] integerzmgmp_GHCziIntegerziType_minusInteger_info
     2.17%  FibbSlow  FibbSlow            [.] ghczmprim_GHCziClasses_zeze_info
     2.09%  FibbSlow  FibbSlow            [.] cicc_info
     2.03%  FibbSlow  FibbSlow            [.] 0x0000000000331e15
     2.02%  FibbSlow  FibbSlow            [.] s3ri_info
     1.91%  FibbSlow  FibbSlow            [.] 0x0000000000331bb8
     1.89%  FibbSlow  FibbSlow            [.] ci4N_info
...
```

Reviewers: simonmar, niteria, bgamari, goldfire

Reviewed By: simonmar, bgamari

Subscribers: lelf, rwbarton, thomie, carter

GHC Trac Issues: #15501

Differential Revision: https://phabricator.haskell.org/D4713

2 files changed, 80 insertions, 6 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 1ba0d89c37..12c3357e47 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -104,7 +104,9 @@ module CLabel (
         -- * Conversions
         toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
 
-        pprCLabel
+        pprCLabel,
+        isInfoTableLabel,
+        isConInfoTableLabel
     ) where
 
 #include "HsVersions.h"
@@ -621,6 +623,19 @@ isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
 isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
 isSomeRODataLabel _lbl = False
 
+-- | Whether label is points to some kind of info table
+isInfoTableLabel :: CLabel -> Bool
+isInfoTableLabel (IdLabel _ _ InfoTable)      = True
+isInfoTableLabel (IdLabel _ _ LocalInfoTable) = True
+isInfoTableLabel (IdLabel _ _ ConInfoTable)   = True
+isInfoTableLabel (IdLabel _ _ BlockInfoTable) = True
+isInfoTableLabel _                            = False
+
+-- | Whether label is points to constructor info table
+isConInfoTableLabel :: CLabel -> Bool
+isConInfoTableLabel (IdLabel _ _ ConInfoTable)   = True
+isConInfoTableLabel _                            = False
+
 -- | Get the label size field from a ForeignLabel
 foreignLabelStdcallInfo :: CLabel -> Maybe Int
 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index c5fbeb544e..03d4fce794 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -170,16 +170,76 @@ pprGloblDecl lbl
   | not (externallyVisibleCLabel lbl) = empty
   | otherwise = text ".globl " <> ppr lbl
 
-pprTypeAndSizeDecl :: CLabel -> SDoc
-pprTypeAndSizeDecl lbl
+pprLabelType' :: DynFlags -> CLabel -> SDoc
+pprLabelType' dflags lbl =
+  if isCFunctionLabel lbl || functionOkInfoTable then
+    text "@function"
+  else
+    text "@object"
+  where
+    {-
+    NOTE: This is a bit hacky.
+
+    With the `tablesNextToCode` info tables look like this:
+    ```
+      <info table data>
+    label_info:
+      <info table code>
+    ```
+    So actually info table label points exactly to the code and we can mark
+    the label as @function. (This is required to make perf and potentially other
+    tools to work on Haskell binaries).
+    This usually works well but it can cause issues with a linker.
+    A linker uses different algorithms for the relocation depending on
+    the symbol type.For some reason, a linker will generate JUMP_SLOT relocation
+    when constructor info table is referenced from a data section.
+    This only happens with static constructor call so
+    we mark _con_info symbols as `@object` to avoid the issue with relocations.
+
+    @SimonMarlow hack explanation:
+    "The reasoning goes like this:
+
+    * The danger when we mark a symbol as `@function` is that the linker will
+      redirect it to point to the PLT and use a `JUMP_SLOT` relocation when
+      the symbol refers to something outside the current shared object.
+      A PLT / JUMP_SLOT reference only works for symbols that we jump to, not
+      for symbols representing data,, nor for info table symbol references which
+      we expect to point directly to the info table.
+    * GHC generates code that might refer to any info table symbol from the text
+      segment, but that's OK, because those will be explicit GOT references
+      generated by the code generator.
+    * When we refer to info tables from the data segment, it's either
+      * a FUN_STATIC/THUNK_STATIC local to this module
+      * a `con_info` that could be from anywhere
+
+    So, the only info table symbols that we might refer to from the data segment
+    of another shared object are `con_info` symbols, so those are the ones we
+    need to exclude from getting the @function treatment.
+    "
+
+    A good place to check for more
+    https://ghc.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
+
+    Another possible hack is to create an extra local function symbol for
+    every code-like thing to give the needed information for to the tools
+    but mess up with the relocation. https://phabricator.haskell.org/D4730
+    -}
+    functionOkInfoTable = tablesNextToCode dflags &&
+      isInfoTableLabel lbl && not (isConInfoTableLabel lbl)
+
+
+pprTypeDecl :: CLabel -> SDoc
+pprTypeDecl lbl
     = sdocWithPlatform $ \platform ->
       if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
-      then text ".type " <> ppr lbl <> ptext (sLit ", @object")
+      then
+        sdocWithDynFlags $ \df ->
+          text ".type " <> ppr lbl <> ptext (sLit  ", ") <> pprLabelType' df lbl
       else empty
 
 pprLabel :: CLabel -> SDoc
 pprLabel lbl = pprGloblDecl lbl
-            $$ pprTypeAndSizeDecl lbl
+            $$ pprTypeDecl lbl
             $$ (ppr lbl <> char ':')
 
 {-
@@ -1346,4 +1406,3 @@ pprFormatOpOpCoerce name format1 format2 op1 op2
 pprCondInstr :: LitString -> Cond -> SDoc -> SDoc
 pprCondInstr name cond arg
   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
-