diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 0a159b330ea65ef6ffcac295b99c543b868692f7..f26e5e22a34a076a4001bff2a4c528e57129c3eb 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -161,6 +161,7 @@ data DumpFlag
| Opt_D_no_debug_output
| Opt_D_dump_faststrings
| Opt_D_faststring_stats
+ | Opt_D_ipe_stats
deriving (Eq, Show, Enum)
-- | Helper function to query whether a given `DumpFlag` is enabled or not.
diff --git a/compiler/GHC/Driver/GenerateCgIPEStub.hs b/compiler/GHC/Driver/GenerateCgIPEStub.hs
index e6ed85cc1d2c4f4fe6f9a68727af67d72a23b9af..6476598283ae9aa8ee752b7bdd98c7fbd45b66fd 100644
--- a/compiler/GHC/Driver/GenerateCgIPEStub.hs
+++ b/compiler/GHC/Driver/GenerateCgIPEStub.hs
@@ -17,7 +17,7 @@ import GHC.Data.Stream (Stream, liftIO)
import qualified GHC.Data.Stream as Stream
import GHC.Driver.Env (hsc_dflags, hsc_logger)
import GHC.Driver.Env.Types (HscEnv)
-import GHC.Driver.Flags (GeneralFlag (Opt_InfoTableMap))
+import GHC.Driver.Flags (GeneralFlag (Opt_InfoTableMap), DumpFlag(Opt_D_ipe_stats))
import GHC.Driver.DynFlags (gopt, targetPlatform)
import GHC.Driver.Config.StgToCmm
import GHC.Driver.Config.Cmm
@@ -30,8 +30,11 @@ import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
import GHC.Types.Tickish (GenTickish (SourceNote))
-import GHC.Unit.Types (Module)
+import GHC.Unit.Types (Module, moduleName)
+import GHC.Unit.Module (moduleNameString)
import GHC.Utils.Misc
+import qualified GHC.Utils.Logger as Logger
+import GHC.Utils.Outputable
{-
Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
@@ -193,11 +196,23 @@ generateCgIPEStub hsc_env this_mod denv s = do
-- Yield Cmm for Info Table Provenance Entries (IPEs)
let denv' = denv {provInfoTables = Map.fromList (map (\(_, i, t) -> (cit_lbl i, t)) labeledInfoTablesWithTickishes)}
- ((ipeStub, ipeCmmGroup), _) = runC (initStgToCmmConfig dflags this_mod) fstate cgState $ getCmm (initInfoTableProv (map sndOf3 labeledInfoTablesWithTickishes) denv')
+ ((mIpeStub, ipeCmmGroup), _) = runC (initStgToCmmConfig dflags this_mod) fstate cgState $ getCmm (initInfoTableProv (map sndOf3 labeledInfoTablesWithTickishes) denv')
(_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup
Stream.yield ipeCmmGroupSRTs
+ ipeStub <- case mIpeStub of
+ Just (stats, stub) -> do
+ -- Print ipe stats if requested
+ liftIO $
+ Logger.putDumpFileMaybe logger
+ Opt_D_ipe_stats
+ ("IPE Stats for module " ++ (moduleNameString $ moduleName this_mod))
+ Logger.FormatText
+ (ppr stats)
+ return stub
+ Nothing -> return mempty
+
return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub}
where
collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 5973fe5ab5ce325e69c3520ea286808887be96b1..5400c1e40021bb5c3fdbc6afa2460fb3aa57037b 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1556,6 +1556,8 @@ dynamic_flags_deps = [
(NoArg (setGeneralFlag Opt_DoTagInferenceChecks))
, make_ord_flag defGhcFlag "dshow-passes"
(NoArg $ forceRecompile >> (setVerbosity $ Just 2))
+ , make_ord_flag defGhcFlag "dipe-stats"
+ (setDumpFlag Opt_D_ipe_stats)
, make_ord_flag defGhcFlag "dfaststring-stats"
(setDumpFlag Opt_D_faststring_stats)
, make_ord_flag defGhcFlag "dno-llvm-mangler"
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index c7bfb40ccbe379e7c9506d76d2aeab7c70ded4e4..8efa8646b1e5ab459884d46865c048cb3d26edd4 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -274,24 +274,23 @@ sizeof_ccs_words platform
where
(ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform
--- | Emit info-table provenance declarations
-initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode CStub
+-- | Emit info-table provenance declarations and track IPE stats
+initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode (Maybe (IPEStats, CStub))
initInfoTableProv infos itmap
= do
cfg <- getStgToCmmConfig
- let ents = convertInfoProvMap infos this_mod itmap
- info_table = stgToCmmInfoTableMap cfg
- platform = stgToCmmPlatform cfg
- this_mod = stgToCmmThisModule cfg
-
+ let (stats, ents) = convertInfoProvMap infos this_mod itmap
+ info_table = stgToCmmInfoTableMap cfg
+ platform = stgToCmmPlatform cfg
+ this_mod = stgToCmmThisModule cfg
case ents of
- [] -> return mempty
+ [] -> return Nothing
_ -> do
-- Emit IPE buffer
emitIpeBufferListNode this_mod ents
-- Create the C stub which initialises the IPE map
- return (ipInitCode info_table platform this_mod)
+ return (Just (stats, ipInitCode info_table platform this_mod))
-- ---------------------------------------------------------------------------
-- Set the current cost centre stack
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 7123ac5d60c4bf7939b8692d9b45e39ed6327f3d..4ad96db7fca7e69773c1152e9f19b1de8917e272 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -7,6 +7,7 @@
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------
+{-# LANGUAGE RecordWildCards #-}
module GHC.StgToCmm.Utils (
emitDataLits, emitRODataLits,
@@ -43,7 +44,7 @@ module GHC.StgToCmm.Utils (
emitUpdRemSetPush,
emitUpdRemSetPushThunk,
- convertInfoProvMap, cmmInfoTableToInfoProvEnt
+ convertInfoProvMap, cmmInfoTableToInfoProvEnt, IPEStats(..)
) where
import GHC.Prelude hiding ( head, init, last, tail )
@@ -90,6 +91,8 @@ import GHC.Types.Unique.FM
import GHC.Data.Maybe
import Control.Monad
import qualified Data.Map.Strict as Map
+import qualified Data.IntMap.Strict as I
+import qualified Data.Semigroup (Semigroup(..))
--------------------------------------------------------------------------
--
@@ -607,20 +610,44 @@ cmmInfoTableToInfoProvEnt this_mod cmit =
cn = rtsClosureType (cit_rep cmit)
in InfoProvEnt cl cn "" this_mod Nothing
+data IPEStats = IPEStats { ipe_total :: !Int
+ , ipe_closure_types :: !(I.IntMap Int)
+ , ipe_default :: !Int }
+
+instance Semigroup IPEStats where
+ (IPEStats a1 a2 a3) <> (IPEStats b1 b2 b3) = IPEStats (a1 + b1) (I.unionWith (+) a2 b2) (a3 + b3)
+
+instance Monoid IPEStats where
+ mempty = IPEStats 0 I.empty 0
+
+defaultIpeStats :: IPEStats
+defaultIpeStats = IPEStats { ipe_total = 0, ipe_closure_types = I.empty, ipe_default = 1}
+closureIpeStats :: Int -> IPEStats
+closureIpeStats t = IPEStats { ipe_total = 1, ipe_closure_types = I.singleton t 1, ipe_default = 0}
+
+instance Outputable IPEStats where
+ ppr = pprIPEStats
+
+pprIPEStats :: IPEStats -> SDoc
+pprIPEStats (IPEStats{..}) =
+ vcat $ [ text "Tables with info:" <+> ppr ipe_total
+ , text "Tables with fallback:" <+> ppr ipe_default
+ ] ++ [ text "Info(" <> ppr k <> text "):" <+> ppr n | (k, n) <- I.assocs ipe_closure_types ]
+
-- | Convert source information collected about identifiers in 'GHC.STG.Debug'
-- to entries suitable for placing into the info table provenance table.
-convertInfoProvMap :: [CmmInfoTable] -> Module -> InfoTableProvMap -> [InfoProvEnt]
+convertInfoProvMap :: [CmmInfoTable] -> Module -> InfoTableProvMap -> (IPEStats, [InfoProvEnt])
convertInfoProvMap defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) =
- map (\cmit ->
+ traverse (\cmit ->
let cl = cit_lbl cmit
cn = rtsClosureType (cit_rep cmit)
tyString :: Outputable a => a -> String
tyString = renderWithContext defaultSDocContext . ppr
- lookupClosureMap :: Maybe InfoProvEnt
+ lookupClosureMap :: Maybe (IPEStats, InfoProvEnt)
lookupClosureMap = case hasHaskellName cl >>= lookupUniqMap denv of
- Just (ty, mbspan) -> Just (InfoProvEnt cl cn (tyString ty) this_mod mbspan)
+ Just (ty, mbspan) -> Just (closureIpeStats cn, (InfoProvEnt cl cn (tyString ty) this_mod mbspan))
Nothing -> Nothing
lookupDataConMap = do
@@ -628,15 +655,15 @@ convertInfoProvMap defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTab
-- This is a bit grimy, relies on the DataCon and Name having the same Unique, which they do
(dc, ns) <- hasHaskellName cl >>= lookupUFM_Directly dcenv . getUnique
-- Lookup is linear but lists will be small (< 100)
- return $ InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns))
+ return $ (closureIpeStats cn, InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns)))
lookupInfoTableToSourceLocation = do
sourceNote <- Map.lookup (cit_lbl cmit) infoTableToSourceLocationMap
- return $ InfoProvEnt cl cn "" this_mod sourceNote
+ return $ (closureIpeStats cn, InfoProvEnt cl cn "" this_mod sourceNote)
-- This catches things like prim closure types and anything else which doesn't have a
-- source location
- simpleFallback = cmmInfoTableToInfoProvEnt this_mod cmit
+ simpleFallback = (defaultIpeStats, cmmInfoTableToInfoProvEnt this_mod cmit)
in
if (isStackRep . cit_rep) cmit then
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index 74da6ccfa065deac509a89b02fcaea49fb647f08..f11632f7b636b185950e1b4256253c0f88538338 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -77,6 +77,14 @@ Dumping out compiler intermediate structures
``!!!`` mark the end of a pass and are accompanied by allocation and
runtime statistics.
+.. ghc-flag:: -dipe-stats
+ :shortdesc: Show statistics about IPE information
+ :type: dynamic
+
+ For each module, show some simple statistics about which info tables have
+ IPE information, and how many info tables with IPE information each closure
+ type has.
+
.. ghc-flag:: -dfaststring-stats
:shortdesc: Show statistics for fast string usage when finished
:type: dynamic
@@ -1202,7 +1210,7 @@ Other
if things go wrong. Which would otherwise be quite difficult.
.. ghc-flag:: -funoptimized-core-for-interpreter
- :shortdesc: Disable optimizations with the interpreter
+ :shortdesc: Disable optimizations with the interpreter
:reverse: -fno-unoptimized-core-for-interpreter
:type: dynamic