Add -finfo-table-map which maps info tables to source positions

This new flag embeds a lookup table from the address of an info table
to information about that info table.

The main interface for consulting the map is the `lookupIPE` C function

> InfoProvEnt * lookupIPE(StgInfoTable *info)

The `InfoProvEnt` has the following structure:

> typedef struct InfoProv_{
>     char * table_name;
>     char * closure_desc;
>     char * ty_desc;
>     char * label;
>     char * module;
>     char * srcloc;
> } InfoProv;
>
> typedef struct InfoProvEnt_ {
>     StgInfoTable * info;
>     InfoProv prov;
>     struct InfoProvEnt_ *link;
> } InfoProvEnt;

The source positions are approximated in a similar way to the source
positions for DWARF debugging information. They are only approximate but
in our experience provide a good enough hint about where the problem
might be. It is therefore recommended to use this flag in conjunction
with `-g<n>` for more accurate locations.

The lookup table is also emitted into the eventlog when it is available
as it is intended to be used with the `-hi` profiling mode.

Using this flag will significantly increase the size of the resulting
object file but only by a factor of 2-3x in our experience.

1 files changed, 53 insertions, 3 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 4b30bc8cf1..1afb97dcd8 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -83,6 +83,9 @@ module GHC.Cmm.CLabel (
         mkForeignLabel,
         mkCCLabel,
         mkCCSLabel,
+        mkIPELabel,
+        InfoProvEnt(..),
+
         mkDynamicLinkerLabel,
         mkPicBaseLabel,
         mkDeadStripPreventer,
@@ -148,6 +151,7 @@ import GHC.Types.Unique.Set
 import GHC.Utils.Misc
 import GHC.Core.Ppr ( {- instances -} )
 import GHC.CmmToAsm.Config
+import GHC.Types.SrcLoc
 
 -- -----------------------------------------------------------------------------
 -- The CLabel type
@@ -251,6 +255,7 @@ data CLabel
 
   | CC_Label  CostCentre
   | CCS_Label CostCentreStack
+  | IPE_Label InfoProvEnt
 
 
   -- | These labels are generated and used inside the NCG only.
@@ -342,6 +347,8 @@ instance Ord CLabel where
     compare a1 a2
   compare (CCS_Label a1) (CCS_Label a2) =
     compare a1 a2
+  compare (IPE_Label a1) (IPE_Label a2) =
+    compare a1 a2
   compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
     compare a1 a2 `thenCmp`
     compare b1 b2
@@ -384,6 +391,8 @@ instance Ord CLabel where
   compare _ HpcTicksLabel{} = GT
   compare SRTLabel{} _ = LT
   compare _ SRTLabel{} = GT
+  compare (IPE_Label {}) _ = LT
+  compare  _ (IPE_Label{}) = GT
 
 -- | Record where a foreign label is stored.
 data ForeignLabelSource
@@ -416,7 +425,7 @@ pprDebugCLabel platform lbl = pprCLabel platform AsmStyle lbl <> parens extra
    where
       extra = case lbl of
          IdLabel _ _ info
-            -> text "IdLabel" <> whenPprDebug (text ":" <> text (show info))
+            -> text "IdLabel" <> whenPprDebug (text ":" <> ppr info)
 
          CmmLabel pkg _ext _name _info
             -> text "CmmLabel" <+> ppr pkg
@@ -452,7 +461,25 @@ data IdLabelInfo
                         -- instead of a closure entry-point.
                         -- See Note [Proc-point local block entry-point].
 
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord)
+
+instance Outputable IdLabelInfo where
+  ppr Closure    = text "Closure"
+  ppr InfoTable  = text "InfoTable"
+  ppr Entry      = text "Entry"
+  ppr Slow       = text "Slow"
+
+  ppr LocalInfoTable  = text "LocalInfoTable"
+  ppr LocalEntry      = text "LocalEntry"
+
+  ppr RednCounts      = text "RednCounts"
+  ppr ConEntry        = text "ConEntry"
+  ppr ConInfoTable    = text "ConInfoTable"
+--  ppr (ConEntry mn) = text "ConEntry" <+> ppr mn
+--  ppr (ConInfoTable mn) = text "ConInfoTable" <+> ppr mn
+  ppr ClosureTable = text "ClosureTable"
+  ppr Bytes        = text "Bytes"
+  ppr BlockInfoTable  = text "BlockInfoTable"
 
 
 data RtsLabelInfo
@@ -710,11 +737,28 @@ foreignLabelStdcallInfo _lbl = Nothing
 mkBitmapLabel   :: Unique -> CLabel
 mkBitmapLabel   uniq            = LargeBitmapLabel uniq
 
+-- | Info Table Provenance Entry
+-- See Note [Mapping Info Tables to Source Positions]
+data InfoProvEnt = InfoProvEnt
+                               { infoTablePtr :: !CLabel
+                               -- Address of the info table
+                               , infoProvEntClosureType :: !Int
+                               -- The closure type of the info table (from ClosureMacros.h)
+                               , infoTableType :: !String
+                               -- The rendered Haskell type of the closure the table represents
+                               , infoProvModule :: !Module
+                               -- Origin module
+                               , infoTableProv :: !(Maybe (RealSrcSpan, String)) }
+                               -- Position and information about the info table
+                               deriving (Eq, Ord)
+
 -- Constructing Cost Center Labels
 mkCCLabel  :: CostCentre      -> CLabel
 mkCCSLabel :: CostCentreStack -> CLabel
+mkIPELabel :: InfoProvEnt -> CLabel
 mkCCLabel           cc          = CC_Label cc
 mkCCSLabel          ccs         = CCS_Label ccs
+mkIPELabel          ipe         = IPE_Label ipe
 
 mkRtsApFastLabel :: FastString -> CLabel
 mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str))
@@ -863,6 +907,7 @@ needsCDecl (CmmLabel pkgId (NeedExternDecl external) _ _)
 needsCDecl l@(ForeignLabel{})           = not (isMathFun l)
 needsCDecl (CC_Label _)                 = True
 needsCDecl (CCS_Label _)                = True
+needsCDecl (IPE_Label {})               = True
 needsCDecl (HpcTicksLabel _)            = True
 needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
 needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
@@ -985,6 +1030,7 @@ externallyVisibleCLabel (ForeignLabel{})        = True
 externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info
 externallyVisibleCLabel (CC_Label _)            = True
 externallyVisibleCLabel (CCS_Label _)           = True
+externallyVisibleCLabel (IPE_Label {})          = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (HpcTicksLabel _)       = True
 externallyVisibleCLabel (LargeBitmapLabel _)    = False
@@ -1044,6 +1090,7 @@ labelType (AsmTempDerivedLabel _ _)             = panic "labelType(AsmTempDerive
 labelType (StringLitLabel _)                    = DataLabel
 labelType (CC_Label _)                          = DataLabel
 labelType (CCS_Label _)                         = DataLabel
+labelType (IPE_Label {})                        = DataLabel
 labelType (DynamicLinkerLabel _ _)              = DataLabel -- Is this right?
 labelType PicBaseLabel                          = DataLabel
 labelType (DeadStripPreventer _)                = DataLabel
@@ -1057,7 +1104,7 @@ idInfoLabelType info =
     LocalInfoTable -> DataLabel
     BlockInfoTable -> DataLabel
     Closure       -> GcPtrLabel
-    ConInfoTable  -> DataLabel
+    ConInfoTable {} -> DataLabel
     ClosureTable  -> DataLabel
     RednCounts    -> DataLabel
     Bytes         -> DataLabel
@@ -1132,6 +1179,7 @@ labelDynamic config lbl =
 
    -- CCS_Label always contains a CostCentre defined in the current module
    CCS_Label _ -> False
+   IPE_Label {} -> True
 
    HpcTicksLabel m ->
      externalDynamicRefs && this_mod /= m
@@ -1356,6 +1404,8 @@ pprCLabel platform sty lbl =
 
    CC_Label cc   -> maybe_underscore $ ppr cc
    CCS_Label ccs -> maybe_underscore $ ppr ccs
+   IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe")
+
 
    CmmLabel _ _ fs CmmCode     -> maybe_underscore $ ftext fs
    CmmLabel _ _ fs CmmData     -> maybe_underscore $ ftext fs