[Git][ghc/ghc][wip/t23702] Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack
Finley McIlwaine (@FinleyMcIlwaine)
gitlab at gitlab.haskell.org
Fri Jul 21 23:47:20 UTC 2023
Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC
Commits:
9237c77f by Finley McIlwaine at 2023-07-21T17:44:48-06:00
Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack
The -finfo-table-map-omit-stack flag omits STACK info tables from the info
table map, and the -finfo-table-map-omit-fallback flag omits info tables
with defaulted source locations from the map. In a test on the Agda
codebase, the build results were about 7% smaller when both of those tables
were omitted.
This commit also refactors a lot of the logic around extracting info tables
from the Cmm results and building the info table map.
Fixes #23702
- - - - -
12 changed files:
- compiler/GHC/Cmm.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Runtime/Heap/Layout.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/StgToCmm/Prof.hs
- compiler/GHC/StgToCmm/Utils.hs
- docs/users_guide/9.8.1-notes.rst
- docs/users_guide/debug-info.rst
- docs/users_guide/debugging.rst
Changes:
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -229,16 +229,15 @@ data CmmInfoTable
-- place to convey this information from the code generator to
-- where we build the static closures in
-- GHC.Cmm.Info.Build.doSRTs.
- } deriving Eq
+ } deriving (Eq, Ord)
instance OutputableP Platform CmmInfoTable where
pdoc = pprInfoTable
-
data ProfilingInfo
= NoProfilingInfo
| ProfilingInfo ByteString ByteString -- closure_type, closure_desc
- deriving Eq
+ deriving (Eq, Ord)
-----------------------------------------------------------------------------
-- Static Data
-----------------------------------------------------------------------------
=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -43,6 +43,8 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
, stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags
, stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags
, stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags
+ , stgToCmmInfoTableMapOmitFallback = gopt Opt_InfoTableMapOmitFallback dflags
+ , stgToCmmInfoTableMapOmitStack = gopt Opt_InfoTableMapOmitStack dflags
, stgToCmmOmitYields = gopt Opt_OmitYields dflags
, stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags
, stgToCmmPIC = gopt Opt_PIC dflags
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -224,6 +224,8 @@ data GeneralFlag
| Opt_DistinctConstructorTables
| Opt_InfoTableMap
+ | Opt_InfoTableMapOmitFallback
+ | Opt_InfoTableMapOmitStack
| Opt_WarnIsError -- -Werror; makes warnings fatal
| Opt_ShowWarnGroups -- Show the group a warning belongs to
=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -1,15 +1,18 @@
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TupleSections #-}
module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub) where
+import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe, listToMaybe)
+import Data.Semigroup ((<>))
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel)
import GHC.Cmm.Dataflow (Block, C, O)
import GHC.Cmm.Dataflow.Block (blockSplit, blockToList)
-import GHC.Cmm.Dataflow.Collections (mapToList)
-import GHC.Cmm.Dataflow.Label (Label)
+import GHC.Cmm.Dataflow.Collections
+import GHC.Cmm.Dataflow.Label (Label, LabelMap)
import GHC.Cmm.Info.Build (emptySRT)
import GHC.Cmm.Pipeline (cmmPipeline)
import GHC.Data.Maybe (firstJusts)
@@ -17,7 +20,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), DumpFlag(Opt_D_ipe_stats))
+import GHC.Driver.Flags (GeneralFlag (..), DumpFlag(Opt_D_ipe_stats))
import GHC.Driver.DynFlags (gopt, targetPlatform)
import GHC.Driver.Config.StgToCmm
import GHC.Driver.Config.Cmm
@@ -27,14 +30,14 @@ import GHC.Settings (Platform, platformTablesNextToCode)
import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState)
import GHC.StgToCmm.Prof (initInfoTableProv)
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
+import GHC.StgToCmm.Utils
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
import GHC.Types.Tickish (GenTickish (SourceNote))
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
+import GHC.Utils.Outputable (ppr)
{-
Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
@@ -190,60 +193,107 @@ generateCgIPEStub hsc_env this_mod denv s = do
cmm_cfg = initCmmConfig dflags
cgState <- liftIO initC
- -- Collect info tables, but only if -finfo-table-map is enabled, otherwise labeledInfoTablesWithTickishes is empty.
- let collectFun = if gopt Opt_InfoTableMap dflags then collect platform else collectNothing
- (labeledInfoTablesWithTickishes, (nonCaffySet, moduleLFInfos)) <- Stream.mapAccumL_ collectFun [] s
+ -- Collect info tables from the Cmm if -finfo-table-map is enabled. If
+ -- -finfo-table-map is not enabled, infoTablesWithTickishes will be empty. If
+ -- -finfo-table-map-with-stack is enabled, any STACK info tables will be
+ -- mapped to their source locations (See Note [Stacktraces from Info Table
+ -- Provenance Entries (IPE based stack unwinding)]). If
+ -- -finfo-table-map-with-stack is not enabled, we need to track how many STACK
+ -- info tables we have skipped (in case -dipe-stats is enabled). Note that
+ -- this is the only stats tracking we do at this stage, so initStats here
+ -- should only ever contain stats about skipped STACK info tables.
+ let
+ collectFun =
+ if gopt Opt_InfoTableMap dflags then
+ collect platform
+ else
+ collectNothing platform
+
+ ((infoTablesWithTickishes, initStats), (nonCaffySet, moduleLFInfos)) <- Stream.mapAccumL_ collectFun (mempty, mempty) s
-- Yield Cmm for Info Table Provenance Entries (IPEs)
- let denv' = denv {provInfoTables = Map.fromList (map (\(_, i, t) -> (cit_lbl i, t)) labeledInfoTablesWithTickishes)}
- ((mIpeStub, ipeCmmGroup), _) = runC (initStgToCmmConfig dflags this_mod) fstate cgState $ getCmm (initInfoTableProv (map sndOf3 labeledInfoTablesWithTickishes) denv')
+ let denv' = denv {provInfoTables = Map.mapKeys cit_lbl infoTablesWithTickishes}
+ ((mIpeStub, ipeCmmGroup), _) = runC (initStgToCmmConfig dflags this_mod) fstate cgState $ getCmm (initInfoTableProv initStats (Map.keys infoTablesWithTickishes) 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
+ 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)
- collect platform acc cmmGroupSRTs = do
- let labelsToInfoTables = collectInfoTables cmmGroupSRTs
- labelsToInfoTablesToTickishes = map (\(l, i) -> (l, i, lookupEstimatedTick platform cmmGroupSRTs l i)) labelsToInfoTables
- return (acc ++ labelsToInfoTablesToTickishes, cmmGroupSRTs)
-
- collectNothing :: [a] -> CmmGroupSRTs -> IO ([a], CmmGroupSRTs)
- collectNothing _ cmmGroupSRTs = pure ([], cmmGroupSRTs)
-
- collectInfoTables :: CmmGroupSRTs -> [(Label, CmmInfoTable)]
- collectInfoTables cmmGroup = concat $ mapMaybe extractInfoTables cmmGroup
-
- extractInfoTables :: GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Maybe [(Label, CmmInfoTable)]
- extractInfoTables (CmmProc h _ _ _) = Just $ mapToList (info_tbls h)
- extractInfoTables _ = Nothing
-
- lookupEstimatedTick :: Platform -> CmmGroupSRTs -> Label -> CmmInfoTable -> Maybe IpeSourceLocation
- lookupEstimatedTick platform cmmGroup infoTableLabel infoTable = do
+ -- These functions are applied to the elements of the stream of
+ -- CmmGroupSRTs. 'collect' populates a map from info table to potential
+ -- source location, and is used when -finfo-table-map is supplied.
+ -- 'collectNothing' does nothing and just throws out the stream elements.
+ collect, collectNothing
+ :: Platform
+ -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
+ -> CmmGroupSRTs
+ -> IO ((Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats), CmmGroupSRTs)
+ collect platform (!acc, !stats) cmmGroupSRTs = do
+ let
+ blocks = concatMap toBlockList (graphs cmmGroupSRTs)
+ labelsToInfoTables = collectInfoTables cmmGroupSRTs
+ (tablesToTickishes, stats') = mapFoldlWithKey (lookupEstimatedTick platform blocks) (acc, stats) labelsToInfoTables
+ return ((tablesToTickishes, stats'), cmmGroupSRTs)
+ collectNothing _ _ cmmGroupSRTs = pure ((Map.empty, mempty), cmmGroupSRTs)
+
+ collectInfoTables :: CmmGroupSRTs -> LabelMap CmmInfoTable
+ collectInfoTables cmmGroup = foldl' extractInfoTables mapEmpty cmmGroup
+
+ extractInfoTables :: LabelMap CmmInfoTable -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> LabelMap CmmInfoTable
+ extractInfoTables acc (CmmProc h _ _ _) = acc `mapUnion` info_tbls h
+ extractInfoTables acc _ = acc
+
+ lookupEstimatedTick
+ :: Platform
+ -> [CmmBlock]
+ -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
+ -> Label
+ -> CmmInfoTable
+ -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
+ lookupEstimatedTick platform blocks (!acc, !stats) infoTableLabel infoTable = do
-- All return frame info tables are stack represented, though not all stack represented info
-- tables have to be return frames.
- if (isStackRep . cit_rep) infoTable
- then do
- let findFun =
- if platformTablesNextToCode platform
- then findCmmTickishWithTNTC infoTableLabel
- else findCmmTickishSansTNTC (cit_lbl infoTable)
- blocks = concatMap toBlockList (graphs cmmGroup)
- firstJusts $ map findFun blocks
- else Nothing
+ if (isStackRep . cit_rep) infoTable then
+ if gopt Opt_InfoTableMapOmitStack (hsc_dflags hsc_env) then
+ -- This is a STACK info table but we DO NOT want to put it in the info
+ -- table map (-finfo-table-map-omit-stack was given), track it as
+ -- skipped
+ (acc, stats <> skippedIpeStats)
+ else
+ -- This is a STACK info table and we DO want to put it in the info
+ -- table map
+ let
+ findFun =
+ if platformTablesNextToCode platform
+ then findCmmTickishWithTNTC infoTableLabel
+ else findCmmTickishSansTNTC (cit_lbl infoTable)
+ -- Avoid retaining the blocks
+ !srcloc =
+ case firstJusts $ map findFun blocks of
+ Just !srcloc -> Just srcloc
+ Nothing -> Nothing
+ in
+ (Map.insert infoTable srcloc acc, stats)
+
+ else
+ -- This is not a STACK info table, so put it in the map with no source
+ -- location (for now)
+ (Map.insert infoTable Nothing acc, stats)
+
graphs :: CmmGroupSRTs -> [CmmGraph]
graphs = foldl' go []
where
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1781,10 +1781,6 @@ dynamic_flags_deps = [
-- Caller-CC
, make_ord_flag defGhcFlag "fprof-callers"
(HasArg setCallerCcFilters)
- , make_ord_flag defGhcFlag "fdistinct-constructor-tables"
- (NoArg (setGeneralFlag Opt_DistinctConstructorTables))
- , make_ord_flag defGhcFlag "finfo-table-map"
- (NoArg (setGeneralFlag Opt_InfoTableMap))
------ Compiler flags -----------------------------------------------
, make_ord_flag defGhcFlag "fasm" (NoArg (setObjBackend ncgBackend))
@@ -2462,7 +2458,11 @@ fFlagsDeps = [
flagSpec "show-error-context" Opt_ShowErrorContext,
flagSpec "cmm-thread-sanitizer" Opt_CmmThreadSanitizer,
flagSpec "split-sections" Opt_SplitSections,
- flagSpec "break-points" Opt_InsertBreakpoints
+ flagSpec "break-points" Opt_InsertBreakpoints,
+ flagSpec "distinct-constructor-tables" Opt_DistinctConstructorTables,
+ flagSpec "info-table-map" Opt_InfoTableMap,
+ flagSpec "info-table-map-omit-stack" Opt_InfoTableMapOmitStack,
+ flagSpec "info-table-map-omit-fallback" Opt_InfoTableMapOmitFallback
]
++ fHoleFlags
@@ -2756,6 +2756,8 @@ impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)
,(Opt_Strictness, turnOn, Opt_WorkerWrapper)
,(Opt_WriteIfSimplifiedCore, turnOn, Opt_WriteInterface)
,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteIfSimplifiedCore)
+ ,(Opt_InfoTableMapOmitStack, turnOn, Opt_InfoTableMap)
+ ,(Opt_InfoTableMapOmitFallback, turnOn, Opt_InfoTableMap)
] ++ validHoleFitsImpliedGFlags
-- General flags that are switched on/off when other general flags are switched
=====================================
compiler/GHC/Runtime/Heap/Layout.hs
=====================================
@@ -175,7 +175,7 @@ data SMRep
| RTSRep -- The RTS needs to declare info tables with specific
Int -- type tags, so this form lets us override the default
SMRep -- tag for an SMRep.
- deriving Eq
+ deriving (Eq, Ord)
-- | True \<=> This is a static closure. Affects how we garbage-collect it.
-- Static closure have an extra static link field at the end.
@@ -193,7 +193,7 @@ data ClosureTypeInfo
| ThunkSelector SelectorOffset
| BlackHole
| IndStatic
- deriving Eq
+ deriving (Eq, Ord)
type ConstrDescription = ByteString -- result of dataConIdentity
type FunArity = Int
@@ -223,7 +223,7 @@ data ArgDescr
| ArgUnknown -- For imported binds.
-- Invariant: Never Unknown for binds of the module
-- we are compiling.
- deriving (Eq)
+ deriving (Eq, Ord)
instance Outputable ArgDescr where
ppr (ArgSpec n) = text "ArgSpec" <+> ppr n
=====================================
compiler/GHC/StgToCmm/Config.hs
=====================================
@@ -52,6 +52,8 @@ data StgToCmmConfig = StgToCmmConfig
, stgToCmmEagerBlackHole :: !Bool -- ^
, stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update.
, stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping
+ , stgToCmmInfoTableMapOmitFallback :: !Bool
+ , stgToCmmInfoTableMapOmitStack :: !Bool
-- Info Tables to Source Positions]
, stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed
, stgToCmmOmitIfPragmas :: !Bool -- ^ true means don't generate interface programs (implied by -O0)
=====================================
compiler/GHC/StgToCmm/Prof.hs
=====================================
@@ -275,11 +275,11 @@ sizeof_ccs_words platform
(ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform
-- | Emit info-table provenance declarations and track IPE stats
-initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode (Maybe (IPEStats, CStub))
-initInfoTableProv infos itmap
+initInfoTableProv :: IPEStats -> [CmmInfoTable] -> InfoTableProvMap -> FCode (Maybe (IPEStats, CStub))
+initInfoTableProv stats infos itmap
= do
cfg <- getStgToCmmConfig
- let (stats, ents) = convertInfoProvMap infos this_mod itmap
+ let (stats', ents) = foldl' (convertInfoProvMap cfg this_mod itmap) (stats, []) infos
info_table = stgToCmmInfoTableMap cfg
platform = stgToCmmPlatform cfg
this_mod = stgToCmmThisModule cfg
@@ -290,7 +290,7 @@ initInfoTableProv infos itmap
emitIpeBufferListNode this_mod ents
-- Create the C stub which initialises the IPE map
- return (Just (stats, ipInitCode info_table platform this_mod))
+ return (Just (stats', ipInitCode info_table platform this_mod))
-- ---------------------------------------------------------------------------
-- Set the current cost centre stack
=====================================
compiler/GHC/StgToCmm/Utils.hs
=====================================
@@ -8,6 +8,7 @@
--
-----------------------------------------------------------------------------
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
module GHC.StgToCmm.Utils (
emitDataLits, emitRODataLits,
@@ -44,7 +45,8 @@ module GHC.StgToCmm.Utils (
emitUpdRemSetPush,
emitUpdRemSetPushThunk,
- convertInfoProvMap, cmmInfoTableToInfoProvEnt, IPEStats(..)
+ convertInfoProvMap, cmmInfoTableToInfoProvEnt, IPEStats(..),
+ closureIpeStats, fallbackIpeStats, skippedIpeStats,
) where
import GHC.Prelude hiding ( head, init, last, tail )
@@ -612,18 +614,23 @@ cmmInfoTableToInfoProvEnt this_mod cmit =
data IPEStats = IPEStats { ipe_total :: !Int
, ipe_closure_types :: !(I.IntMap Int)
- , ipe_default :: !Int }
+ , ipe_fallback :: !Int
+ , ipe_skipped :: !Int }
instance Semigroup IPEStats where
- (IPEStats a1 a2 a3) <> (IPEStats b1 b2 b3) = IPEStats (a1 + b1) (I.unionWith (+) a2 b2) (a3 + b3)
+ (IPEStats a1 a2 a3 a4) <> (IPEStats b1 b2 b3 b4) = IPEStats (a1 + b1) (I.unionWith (+) a2 b2) (a3 + b3) (a4 + b4)
instance Monoid IPEStats where
- mempty = IPEStats 0 I.empty 0
+ mempty = IPEStats 0 I.empty 0 0
+
+fallbackIpeStats :: IPEStats
+fallbackIpeStats = mempty { ipe_total = 1, ipe_fallback = 1 }
-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}
+closureIpeStats t = mempty { ipe_total = 1, ipe_closure_types = I.singleton t 1 }
+
+skippedIpeStats :: IPEStats
+skippedIpeStats = mempty { ipe_skipped = 1 }
instance Outputable IPEStats where
ppr = pprIPEStats
@@ -631,14 +638,14 @@ instance Outputable IPEStats where
pprIPEStats :: IPEStats -> SDoc
pprIPEStats (IPEStats{..}) =
vcat $ [ text "Tables with info:" <+> ppr ipe_total
- , text "Tables with fallback:" <+> ppr ipe_default
+ , text "Tables with fallback:" <+> ppr ipe_fallback
+ , text "Tables skipped:" <+> ppr ipe_skipped
] ++ [ 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 -> (IPEStats, [InfoProvEnt])
-convertInfoProvMap defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) =
- traverse (\cmit ->
+convertInfoProvMap :: StgToCmmConfig -> Module -> InfoTableProvMap -> (IPEStats, [InfoProvEnt]) -> CmmInfoTable -> (IPEStats, [InfoProvEnt])
+convertInfoProvMap cfg this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) (!stats, acc) cmit =
let cl = cit_lbl cmit
cn = rtsClosureType (cit_rep cmit)
@@ -650,23 +657,42 @@ convertInfoProvMap defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTab
Just (ty, mbspan) -> Just (closureIpeStats cn, (InfoProvEnt cl cn (tyString ty) this_mod mbspan))
Nothing -> Nothing
- lookupDataConMap = do
+ lookupDataConMap :: Maybe (IPEStats, InfoProvEnt)
+ lookupDataConMap = (closureIpeStats cn,) <$> do
UsageSite _ n <- hasIdLabelInfo cl >>= getConInfoTableLocation
-- 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 $ (closureIpeStats cn, InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns)))
+ return $ (InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns)))
+ lookupInfoTableToSourceLocation :: Maybe (IPEStats, InfoProvEnt)
lookupInfoTableToSourceLocation = do
sourceNote <- Map.lookup (cit_lbl cmit) infoTableToSourceLocationMap
- return $ (closureIpeStats cn, 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 = (defaultIpeStats, cmmInfoTableToInfoProvEnt this_mod cmit)
+ simpleFallback =
+ if stgToCmmInfoTableMapOmitFallback cfg then
+ -- If we are omitting tables with fallback info, do not create an
+ -- entry
+ Nothing
+ else
+ -- Create a default entry with fallback IPE data
+ Just (fallbackIpeStats, cmmInfoTableToInfoProvEnt this_mod cmit)
+
+ trackSkipped :: Maybe (IPEStats, InfoProvEnt) -> (IPEStats, [InfoProvEnt])
+ trackSkipped Nothing =
+ (stats Data.Semigroup.<> skippedIpeStats, acc)
+ trackSkipped (Just (s, !c)) =
+ (stats Data.Semigroup.<> s, c:acc)
in
- if (isStackRep . cit_rep) cmit then
- fromMaybe simpleFallback lookupInfoTableToSourceLocation
- else
- fromMaybe simpleFallback (lookupDataConMap `firstJust` lookupClosureMap)) defns
+ trackSkipped $
+ if (isStackRep . cit_rep) cmit then
+ -- Note that we should have already skipped STACK info tables if
+ -- necessary in 'generateCgIPEStub', so we should not need to worry
+ -- about doing that here.
+ fromMaybe simpleFallback (Just <$> lookupInfoTableToSourceLocation)
+ else
+ fromMaybe simpleFallback (Just <$> firstJust lookupDataConMap lookupClosureMap)
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -161,7 +161,7 @@ Compiler
`libzstd <https://github.com/facebook/zstd/>`_ version 1.4.0 or greater
installed. The compression library `libzstd` may optionally be statically
linked in the resulting compiler (on non-darwin machines) using the
- `--enable-static-libzstd` configure flag.
+ ``--enable-static-libzstd`` configure flag.
In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map`
enabled build results was reduced by over 20% when compression was enabled.
=====================================
docs/users_guide/debug-info.rst
=====================================
@@ -391,6 +391,37 @@ to a source location. This lookup table is generated by using the ``-finfo-table
In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map`
enabled build results was reduced by over 20% when compression was enabled.
+.. ghc-flag:: -finfo-table-map-omit-stack
+ :shortdesc: Omit info tables for ``STACK`` closures from the info table
+ map.
+ :type: dynamic
+ :category: debugging
+
+ :since: 9.9
+ :implies: :ghc-flag:`-finfo-table-map`
+
+ ``STACK`` info tables are often the majority of entries in the info table
+ map. However, despite their contribution to the executable size, they are
+ rarely useful unless debugging with a tool such as `ghc-debug
+ <https://gitlab.haskell.org/ghc/ghc-debug>`_. Use this flag to omit
+ ``STACK`` info tables from the info table map and decrease the executable
+ size.
+
+.. ghc-flag:: -finfo-table-map-omit-fallback
+ :shortdesc: Omit info tables with no source location information from the
+ info table map.
+ :type: dynamic
+ :category: debugging
+
+ :since: 9.9
+ :implies: :ghc-flag:`-finfo-table-map`
+
+ Some info tables, such as those for primitive closure types, will have no
+ provenance location in the program source. With
+ :ghc-flag:`-finfo-table-map`, those info tables are given default source
+ locations and included in the info table map. Use this flag to omit them
+ from the info table map and decrease the executable size.
+
.. ghc-flag:: -fdistinct-constructor-tables
:shortdesc: Generate a fresh info table for each usage
of a data constructor.
@@ -406,7 +437,6 @@ to a source location. This lookup table is generated by using the ``-finfo-table
than the data constructor itself.
-
Querying the Info Table Map
---------------------------
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -83,7 +83,8 @@ Dumping out compiler intermediate structures
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.
+ type has. This is useful, for example, for verifying that ``STACK`` info
+ tables are being appropriately omitted or included from the info table map.
.. ghc-flag:: -dfaststring-stats
:shortdesc: Show statistics for fast string usage when finished
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9237c77fb7a177aa176e9bb600864ee6679fc4a4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9237c77fb7a177aa176e9bb600864ee6679fc4a4
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230721/b3ebda41/attachment-0001.html>
More information about the ghc-commits
mailing list