[Git][ghc/ghc][wip/romes/12935] 3 commits: cleaner approach, same idea
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Fri Jun 21 15:18:15 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
8da04b1b by Rodrigo Mesquita at 2024-06-21T15:58:33+01:00
cleaner approach, same idea
- - - - -
ab410ec4 by Rodrigo Mesquita at 2024-06-21T15:58:42+01:00
Revert "Reapply "Do uniq renaming before SRTs""
This reverts commit 70ff49b7efc8c1fca46cba6eff630c5d39a99213.
- - - - -
ffd9d859 by Rodrigo Mesquita at 2024-06-21T16:18:04+01:00
Finfixes
- - - - -
6 changed files:
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/StgToCmm.hs
Changes:
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -19,7 +19,6 @@ import GHC.Cmm.ProcPoint
import GHC.Cmm.Sink
import GHC.Cmm.Switch.Implement
import GHC.Cmm.ThreadSanitizer
-import GHC.Cmm.UniqueRenamer
import GHC.Types.Unique.Supply
@@ -31,8 +30,6 @@ import GHC.Utils.Misc ( partitionWithM )
import GHC.Platform
import Control.Monad
-import Data.List (mapAccumL)
-import Data.Bifunctor
-----------------------------------------------------------------------------
-- | Top level driver for C-- pipeline
@@ -45,38 +42,18 @@ cmmPipeline
:: Logger
-> CmmConfig
-> ModuleSRTInfo -- Info about SRTs generated so far
- -> DetUniqFM
-> CmmGroup -- Input C-- with Procedures
- -> IO (ModuleSRTInfo, (DetUniqFM, CmmGroupSRTs)) -- Output CPS transformed C--
+ -> IO (ModuleSRTInfo, CmmGroupSRTs) -- Output CPS transformed C--
-cmmPipeline logger cmm_config srtInfo0 detRnEnv0 prog = do
+cmmPipeline logger cmm_config srtInfo prog = do
let forceRes (info, group) = info `seq` foldr seq () group
let platform = cmmPlatform cmm_config
withTimingSilent logger (text "Cmm pipeline") forceRes $ do
+ (procs, data_) <- {-# SCC "tops" #-} partitionWithM (cpsTop logger platform cmm_config) prog
+ (srtInfo, cmms) <- {-# SCC "doSRTs" #-} doSRTs cmm_config srtInfo procs data_
+ dumpWith logger Opt_D_dump_cmm_cps "Post CPS Cmm" FormatCMM (pdoc platform cmms)
- -- To produce deterministic object code, we alpha-rename all Uniques to deterministic uniques before Cmm linting.
- -- From here on out, the backend code generation can't use (non-deterministic) Uniques, or risk producing non-deterministic code.
- -- For example, the fix-up action in the ASM NCG should use determinist names for potential new blocks it has to create.
- -- Therefore, in the ASM NCG `NatM` Monad we use a deterministic `UniqSuply` (which won't be shared about multiple threads)
- -- TODO: Put these all into notes carefully organized
- let (detRnEnv1, renamed_prog) = detRenameUniques detRnEnv0 prog -- TODO: if gopt Opt_DeterministicObjects dflags
-
- (procs, data_) <- {-# SCC "tops" #-} partitionWithM (cpsTop logger platform cmm_config) renamed_prog
- -- We also have to rename `data_` since it is not fully determined from
- -- the renamed CLabels in renamed_prog.
- -- We may also generate new names in procs, so rename that too.
- -- We need to do this before SRT generation because otherwise we may look
- -- at the "old names" within the body of the function we are generating SRTs for.
- -- Easy easy: rename before and after.
- -- Easy easy: but that turns out to be really slow, so let's try renaming
- -- procs and data instead and hope srts are generated using names found there.
- -- And don't rename procs just yet, ehhh
- let (detRnEnv2, data_renamed) = mapAccumL (\rne (a,b) -> second (a,) $ detRenameUniques rne b) detRnEnv1 data_
- (srtInfo1, cmms) <- {-# SCC "doSRTs" #-} doSRTs cmm_config srtInfo0 procs data_renamed
- dumpWith logger Opt_D_dump_cmm_cps "Post CPS Cmm (uniq-renamed)" FormatCMM (pdoc platform cmms)
-
- return (srtInfo1, (detRnEnv2, cmms))
-
+ return (srtInfo, cmms)
-- | The Cmm pipeline for a single 'CmmDecl'. Returns:
--
=====================================
compiler/GHC/Cmm/UniqueRenamer.hs
=====================================
@@ -15,7 +15,7 @@ import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Switch
-import GHC.Cmm.Info.Build
+-- import GHC.Cmm.Info.Build
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Utils.Outputable as Outputable
@@ -119,18 +119,18 @@ instance (UniqRenamable a, UniqRenamable b) => UniqRenamable (GenCmmDecl a b Cmm
uniqRename (CmmData sec d)
= CmmData <$> uniqRename sec <*> uniqRename d
-instance UniqRenamable ModuleSRTInfo where
- uniqRename
- ModuleSRTInfo{thisModule, dedupSRTs, flatSRTs, moduleSRTMap}
- -- ROMES:TODO: I feel like we don't really need to do this for all of these maps, and can shortcut some of this
- -- Nonetheless, in order to produce a working prototype, I'm just always renaming them all. We can optimise later.
- = ModuleSRTInfo thisModule <$> uniqRename dedupSRTs <*> uniqRename flatSRTs <*> uniqRename moduleSRTMap
+-- instance UniqRenamable ModuleSRTInfo where
+-- uniqRename
+-- ModuleSRTInfo{thisModule, dedupSRTs, flatSRTs, moduleSRTMap}
+-- -- ROMES:TODO: I feel like we don't really need to do this for all of these maps, and can shortcut some of this
+-- -- Nonetheless, in order to produce a working prototype, I'm just always renaming them all. We can optimise later.
+-- = ModuleSRTInfo thisModule <$> uniqRename dedupSRTs <*> uniqRename flatSRTs <*> uniqRename moduleSRTMap
-instance UniqRenamable SRTEntry where
- uniqRename (SRTEntry cl) = SRTEntry <$> uniqRename cl
+-- instance UniqRenamable SRTEntry where
+-- uniqRename (SRTEntry cl) = SRTEntry <$> uniqRename cl
-instance UniqRenamable CAFfyLabel where
- uniqRename (CAFfyLabel cl) = CAFfyLabel <$> uniqRename cl
+-- instance UniqRenamable CAFfyLabel where
+-- uniqRename (CAFfyLabel cl) = CAFfyLabel <$> uniqRename cl
instance UniqRenamable CmmDataDecl where
uniqRename (CmmData sec d)
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -39,6 +39,7 @@ import GHC.Data.OsPath
import qualified GHC.Data.ShortText as ST
import GHC.Data.Stream ( Stream )
import qualified GHC.Data.Stream as Stream
+import GHC.Cmm.UniqueRenamer
import GHC.Utils.TmpFs
@@ -95,12 +96,23 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g
cmm_stream
=
do {
+ -- To produce deterministic object code, we alpha-rename all Uniques to deterministic uniques before Cmm linting.
+ -- From here on out, the backend code generation can't use (non-deterministic) Uniques, or risk producing non-deterministic code.
+ -- For example, the fix-up action in the ASM NCG should use determinist names for potential new blocks it has to create.
+ -- Therefore, in the ASM NCG `NatM` Monad we use a deterministic `UniqSuply` (which won't be shared about multiple threads)
+ -- TODO: Put these all into notes carefully organized
+ ; let renamed_cmm_stream = do
+ -- if gopt Opt_DeterministicObjects dflags
+
+ (rn_mapping, stream) <- Stream.mapAccumL_ (fmap pure . detRenameUniques) emptyDetUFM cmm_stream
+ Stream.liftIO $ debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping)
+ return stream
-- Lint each CmmGroup as it goes past
; let linted_cmm_stream =
if gopt Opt_DoCmmLinting dflags
- then Stream.mapM do_lint cmm_stream
- else cmm_stream
+ then Stream.mapM do_lint renamed_cmm_stream
+ else renamed_cmm_stream
do_lint cmm = withTimingSilent logger
(text "CmmLint"<+>brackets (ppr this_mod))
=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -35,7 +35,6 @@ import GHC.Unit.Types (Module, moduleName)
import GHC.Unit.Module (moduleNameString)
import qualified GHC.Utils.Logger as Logger
import GHC.Utils.Outputable (ppr)
-import GHC.Cmm.UniqueRenamer (emptyDetUFM)
{-
Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
@@ -212,7 +211,7 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW
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) emptyDetUFM ipeCmmGroup
+ (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup
Stream.yield ipeCmmGroupSRTs
ipeStub <-
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -300,8 +300,6 @@ import GHC.StgToCmm.Utils (IPEStats)
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Cmm.Config (CmmConfig)
-import GHC.Cmm.UniqueRenamer
-import Data.Bifunctor
{- **********************************************************************
@@ -2087,7 +2085,6 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
$ parseCmmFile cmmpConfig cmm_mod home_unit filename
let msgs = warns `unionMessages` errs
return (GhcPsMessage <$> msgs, cmm)
-
liftIO $ do
putDumpFileMaybe logger Opt_D_dump_cmm_verbose_by_proc "Parsed Cmm" FormatCMM (pdoc platform cmm)
@@ -2097,10 +2094,8 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
-- Re-ordering here causes breakage when booting with C backend because
-- in C we must declare before use, but SRT algorithm is free to
-- re-order [A, B] (B refers to A) when A is not CAFFY and return [B, A]
- (rn_mapping, cmmgroup) <-
- second concat <$> mapAccumLM (\rn_mapping cmm -> snd <$> cmmPipeline logger cmm_config (emptySRT cmm_mod) rn_mapping [cmm]) emptyDetUFM cmm
-
- debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping)
+ cmmgroup <-
+ concatMapM (\cmm -> snd <$> cmmPipeline logger cmm_config (emptySRT cmm_mod) [cmm]) cmm
unless (null cmmgroup) $
putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm"
@@ -2198,10 +2193,9 @@ doCodeGen hsc_env this_mod denv data_tycons
pipeline_stream :: Stream IO CmmGroupSRTs CmmCgInfos
pipeline_stream = do
- ((mod_srt_info, ipes, ipe_stats, rn_mapping), lf_infos) <-
+ ((mod_srt_info, ipes, ipe_stats), lf_infos) <-
{-# SCC "cmmPipeline" #-}
- Stream.mapAccumL_ (pipeline_action logger cmm_config) (emptySRT this_mod, M.empty, mempty, emptyDetUFM) ppr_stream1
- liftIO $ debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping)
+ Stream.mapAccumL_ (pipeline_action logger cmm_config) (emptySRT this_mod, M.empty, mempty) ppr_stream1
let nonCaffySet = srtMapNonCAFs (moduleSRTMap mod_srt_info)
cmmCgInfos <- generateCgIPEStub hsc_env this_mod denv (nonCaffySet, lf_infos, ipes, ipe_stats)
return cmmCgInfos
@@ -2209,11 +2203,11 @@ doCodeGen hsc_env this_mod denv data_tycons
pipeline_action
:: Logger
-> CmmConfig
- -> (ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats, DetUniqFM)
+ -> (ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> CmmGroup
- -> IO ((ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats, DetUniqFM), CmmGroupSRTs)
- pipeline_action logger cmm_config (mod_srt_info, ipes, stats, detRnEnv) cmm_group = do
- (mod_srt_info', (rn_mapping, cmm_srts)) <- cmmPipeline logger cmm_config mod_srt_info detRnEnv cmm_group
+ -> IO ((ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats), CmmGroupSRTs)
+ pipeline_action logger cmm_config (mod_srt_info, ipes, stats) cmm_group = do
+ (mod_srt_info', cmm_srts) <- cmmPipeline logger cmm_config mod_srt_info cmm_group
-- If -finfo-table-map is enabled, we precompute a map from info
-- tables to source locations. See Note [Mapping Info Tables to Source
@@ -2224,7 +2218,7 @@ doCodeGen hsc_env this_mod denv data_tycons
else
return (ipes, stats)
- return ((mod_srt_info', ipes', stats', rn_mapping), cmm_srts)
+ return ((mod_srt_info', ipes', stats'), cmm_srts)
dump2 a = do
unless (null a) $
=====================================
compiler/GHC/StgToCmm.hs
=====================================
@@ -14,6 +14,7 @@ module GHC.StgToCmm ( codeGen ) where
import GHC.Prelude as Prelude
+import GHC.Cmm.UniqueRenamer
import GHC.StgToCmm.Prof (initCostCentres, ldvEnter)
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Env
@@ -86,18 +87,31 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
-- we would need to add a state monad layer which regresses
-- allocations by 0.5-2%.
; cgref <- liftIO $ initC >>= \s -> newIORef s
+ ; uniqRnRef <- liftIO $ newIORef emptyDetUFM
+ ; let fstate = initFCodeState $ stgToCmmPlatform cfg
; let cg :: FCode a -> Stream IO CmmGroup a
cg fcode = do
(a, cmm) <- liftIO . withTimingSilent logger (text "STG -> Cmm") (`seq` ()) $ do
st <- readIORef cgref
- let fstate = initFCodeState $ stgToCmmPlatform cfg
- let (a,st') = runC cfg fstate st (getCmm fcode)
+
+ -- To produce deterministic object code, we alpha-rename all Uniques to deterministic uniques before Cmm linting.
+ -- From here on out, the backend code generation can't use (non-deterministic) Uniques, or risk producing non-deterministic code.
+ -- For example, the fix-up action in the ASM NCG should use determinist names for potential new blocks it has to create.
+ -- Therefore, in the ASM NCG `NatM` Monad we use a deterministic `UniqSuply` (which won't be shared about multiple threads)
+ -- TODO: Put these all into notes carefully organized
+ rnm0 <- readIORef uniqRnRef
+
+ let
+ ((a, cmm), st') = runC cfg fstate st (getCmm fcode)
+ (rnm1, cmm_renamed) = detRenameUniques rnm0 cmm -- The yielded cmm will already be renamed.
-- NB. stub-out cgs_tops and cgs_stmts. This fixes
-- a big space leak. DO NOT REMOVE!
-- This is observed by the #3294 test
writeIORef cgref $! (st'{ cgs_tops = nilOL, cgs_stmts = mkNop })
- return a
+ writeIORef uniqRnRef $! rnm1
+
+ return (a, cmm_renamed)
yield cmm
return a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf0a17ad26a9ba46b0169a0b97cfa7696c02286c...ffd9d8591c745115d68c994fcd0daff30489d422
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf0a17ad26a9ba46b0169a0b97cfa7696c02286c...ffd9d8591c745115d68c994fcd0daff30489d422
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/20240621/f69b1e18/attachment-0001.html>
More information about the ghc-commits
mailing list