{-# LANGUAGE GADTs #-}
module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Semigroup ((<>))
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel)
import GHC.Cmm.Dataflow (O)
import GHC.Cmm.Dataflow.Block (blockSplit, blockToList)
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label (Label)
import GHC.Cmm.Info.Build (emptySRT)
import GHC.Cmm.Pipeline (cmmPipeline)
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 (..), DumpFlag(Opt_D_ipe_stats))
import GHC.Driver.Session (gopt, targetPlatform)
import GHC.Driver.Config.StgToCmm
import GHC.Driver.Config.Cmm
import GHC.Prelude
import GHC.Runtime.Heap.Layout (isStackRep)
import GHC.Settings (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 qualified GHC.Utils.Logger as Logger
import GHC.Utils.Outputable (ppr)
generateCgIPEStub
:: HscEnv
-> Module
-> InfoTableProvMap
-> ( NonCaffySet
, ModuleLFInfos
, Map CmmInfoTable (Maybe IpeSourceLocation)
, IPEStats
)
-> Stream IO CmmGroupSRTs CmmCgInfos
generateCgIPEStub :: HscEnv
-> Module
-> InfoTableProvMap
-> (NonCaffySet, ModuleLFInfos,
Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Stream IO CmmGroupSRTs CmmCgInfos
generateCgIPEStub HscEnv
hsc_env Module
this_mod InfoTableProvMap
denv (NonCaffySet
nonCaffySet, ModuleLFInfos
moduleLFInfos, Map CmmInfoTable (Maybe IpeSourceLocation)
infoTablesWithTickishes, IPEStats
initStats) = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
fstate :: FCodeState
fstate = Platform -> FCodeState
initFCodeState Platform
platform
cmm_cfg :: CmmConfig
cmm_cfg = DynFlags -> CmmConfig
initCmmConfig DynFlags
dflags
CgState
cgState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CgState
initC
let denv' :: InfoTableProvMap
denv' = InfoTableProvMap
denv {provInfoTables :: InfoTableToSourceLocationMap
provInfoTables = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys CmmInfoTable -> CLabel
cit_lbl Map CmmInfoTable (Maybe IpeSourceLocation)
infoTablesWithTickishes}
((Maybe (IPEStats, CStub)
mIpeStub, CmmGroup
ipeCmmGroup), CgState
_) = forall a.
StgToCmmConfig -> FCodeState -> CgState -> FCode a -> (a, CgState)
runC (DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig DynFlags
dflags Module
this_mod) FCodeState
fstate CgState
cgState forall a b. (a -> b) -> a -> b
$ forall a. FCode a -> FCode (a, CmmGroup)
getCmm (IPEStats
-> [CmmInfoTable]
-> InfoTableProvMap
-> FCode (Maybe (IPEStats, CStub))
initInfoTableProv IPEStats
initStats (forall k a. Map k a -> [k]
Map.keys Map CmmInfoTable (Maybe IpeSourceLocation)
infoTablesWithTickishes) InfoTableProvMap
denv')
(ModuleSRTInfo
_, CmmGroupSRTs
ipeCmmGroupSRTs) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger
-> CmmConfig
-> ModuleSRTInfo
-> CmmGroup
-> IO (ModuleSRTInfo, CmmGroupSRTs)
cmmPipeline Logger
logger CmmConfig
cmm_cfg (Module -> ModuleSRTInfo
emptySRT Module
this_mod) CmmGroup
ipeCmmGroup
forall (m :: * -> *) a. Monad m => a -> Stream m a ()
Stream.yield CmmGroupSRTs
ipeCmmGroupSRTs
CStub
ipeStub <-
case Maybe (IPEStats, CStub)
mIpeStub of
Just (IPEStats
stats, CStub
stub) -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
Logger.putDumpFileMaybe Logger
logger
DumpFlag
Opt_D_ipe_stats
(String
"IPE Stats for module " forall a. [a] -> [a] -> [a]
++ (ModuleName -> String
moduleNameString forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod))
DumpFormat
Logger.FormatText
(forall a. Outputable a => a -> SDoc
ppr IPEStats
stats)
forall (m :: * -> *) a. Monad m => a -> m a
return CStub
stub
Maybe (IPEStats, CStub)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
forall (m :: * -> *) a. Monad m => a -> m a
return CmmCgInfos {cgNonCafs :: NonCaffySet
cgNonCafs = NonCaffySet
nonCaffySet, cgLFInfos :: ModuleLFInfos
cgLFInfos = ModuleLFInfos
moduleLFInfos, cgIPEStub :: CStub
cgIPEStub = CStub
ipeStub}
lookupEstimatedTicks
:: HscEnv
-> Map CmmInfoTable (Maybe IpeSourceLocation)
-> IPEStats
-> CmmGroupSRTs
-> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
lookupEstimatedTicks :: HscEnv
-> Map CmmInfoTable (Maybe IpeSourceLocation)
-> IPEStats
-> CmmGroupSRTs
-> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
lookupEstimatedTicks HscEnv
hsc_env Map CmmInfoTable (Maybe IpeSourceLocation)
ipes IPEStats
stats CmmGroupSRTs
cmm_group_srts =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
collectInfoTables (Map CmmInfoTable (Maybe IpeSourceLocation)
ipes, IPEStats
stats) CmmGroupSRTs
cmm_group_srts
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
labelsToSources :: Map CLabel IpeSourceLocation
labelsToSources :: Map CLabel IpeSourceLocation
labelsToSources =
if Platform -> Bool
platformTablesNextToCode Platform
platform then
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesWithTNTC forall k a. Map k a
Map.empty CmmGroupSRTs
cmm_group_srts
else
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesSansTNTC forall k a. Map k a
Map.empty CmmGroupSRTs
cmm_group_srts
collectInfoTables
:: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
collectInfoTables :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
collectInfoTables (!Map CmmInfoTable (Maybe IpeSourceLocation)
acc, !IPEStats
stats) (CmmProc CmmTopInfo
h CLabel
_ [GlobalReg]
_ CmmGraph
_) =
forall (map :: * -> *) b a.
IsMap map =>
(b -> KeyOf map -> a -> b) -> b -> map a -> b
mapFoldlWithKey (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Label
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
go (Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats) (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
h)
where
go :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Label
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
go :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Label
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
go (!Map CmmInfoTable (Maybe IpeSourceLocation)
acc, !IPEStats
stats) Label
lbl' CmmInfoTable
tbl =
let
lbl :: CLabel
lbl =
if Platform -> Bool
platformTablesNextToCode Platform
platform then
forall a. Uniquable a => a -> CLabel
mkAsmTempLabel Label
lbl'
else
CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
tbl
in
if (SMRep -> Bool
isStackRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmInfoTable -> SMRep
cit_rep) CmmInfoTable
tbl then
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_InfoTableMapWithStack DynFlags
dflags then
(forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CmmInfoTable
tbl (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CLabel
lbl Map CLabel IpeSourceLocation
labelsToSources) Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats)
else
(Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats forall a. Semigroup a => a -> a -> a
<> IPEStats
skippedIpeStats)
else
(forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CmmInfoTable
tbl forall a. Maybe a
Nothing Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats)
collectInfoTables (!Map CmmInfoTable (Maybe IpeSourceLocation)
acc, !IPEStats
stats) GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
_ = (Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats)
labelsToSourcesWithTNTC
:: Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesWithTNTC :: Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesWithTNTC Map CLabel IpeSourceLocation
acc (CmmProc CmmTopInfo
_ CLabel
_ [GlobalReg]
_ CmmGraph
cmm_graph) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc (CmmGraph -> [CmmBlock]
toBlockList CmmGraph
cmm_graph)
where
go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
go :: Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc CmmBlock
block =
case (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CLabel
returnFrameLabel forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe IpeSourceLocation
lastTickInBlock of
Just (CLabel
clabel, IpeSourceLocation
src_loc) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CLabel
clabel IpeSourceLocation
src_loc Map CLabel IpeSourceLocation
acc
Maybe (CLabel, IpeSourceLocation)
Nothing -> Map CLabel IpeSourceLocation
acc
where
(CmmNode C O
_, Block CmmNode O O
middleBlock, CmmNode O C
endBlock) = forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
returnFrameLabel :: Maybe CLabel
returnFrameLabel :: Maybe CLabel
returnFrameLabel =
case CmmNode O C
endBlock of
(CmmCall CmmExpr
_ (Just Label
l) [GlobalReg]
_ ByteOff
_ ByteOff
_ ByteOff
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Uniquable a => a -> CLabel
mkAsmTempLabel Label
l
CmmNode O C
_ -> forall a. Maybe a
Nothing
lastTickInBlock :: Maybe IpeSourceLocation
lastTickInBlock = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
maybeTick forall a. Maybe a
Nothing (forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
middleBlock)
maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
maybeTick CmmNode O O
_ s :: Maybe IpeSourceLocation
s@(Just IpeSourceLocation
_) = Maybe IpeSourceLocation
s
maybeTick (CmmTick (SourceNote RealSrcSpan
span String
name)) Maybe IpeSourceLocation
Nothing = forall a. a -> Maybe a
Just (RealSrcSpan
span, String
name)
maybeTick CmmNode O O
_ Maybe IpeSourceLocation
_ = forall a. Maybe a
Nothing
labelsToSourcesWithTNTC Map CLabel IpeSourceLocation
acc GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
_ = Map CLabel IpeSourceLocation
acc
labelsToSourcesSansTNTC
:: Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesSansTNTC :: Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesSansTNTC Map CLabel IpeSourceLocation
acc (CmmProc CmmTopInfo
_ CLabel
_ [GlobalReg]
_ CmmGraph
cmm_graph) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc (CmmGraph -> [CmmBlock]
toBlockList CmmGraph
cmm_graph)
where
go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
go :: Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc CmmBlock
block = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> CmmNode O O
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
collectLabels (Map CLabel IpeSourceLocation
acc, forall a. Maybe a
Nothing) (forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
middleBlock)
where
(CmmNode C O
_, Block CmmNode O O
middleBlock, CmmNode O C
_) = forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
collectLabels
:: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> CmmNode O O
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
collectLabels :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> CmmNode O O
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
collectLabels (!Map CLabel IpeSourceLocation
acc, Maybe IpeSourceLocation
lastTick) CmmNode O O
b =
case (CmmNode O O
b, Maybe IpeSourceLocation
lastTick) of
(CmmStore CmmExpr
_ (CmmLit (CmmLabel CLabel
l)) AlignmentSpec
_, Just IpeSourceLocation
src_loc) ->
(forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CLabel
l IpeSourceLocation
src_loc Map CLabel IpeSourceLocation
acc, forall a. Maybe a
Nothing)
(CmmTick (SourceNote RealSrcSpan
span String
name), Maybe IpeSourceLocation
_) ->
(Map CLabel IpeSourceLocation
acc, forall a. a -> Maybe a
Just (RealSrcSpan
span, String
name))
(CmmNode O O, Maybe IpeSourceLocation)
_ -> (Map CLabel IpeSourceLocation
acc, Maybe IpeSourceLocation
lastTick)
labelsToSourcesSansTNTC Map CLabel IpeSourceLocation
acc GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
_ = Map CLabel IpeSourceLocation
acc