[Git][ghc/ghc][wip/romes/12935] 3 commits: Do uniq-renaming pass right at `codeGen`

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Thu Jun 20 06:44:03 UTC 2024



Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC


Commits:
74e9068a by Rodrigo Mesquita at 2024-06-19T16:34:07+01:00
Do uniq-renaming pass right at `codeGen`

not better

- - - - -
268439c3 by Rodrigo Mesquita at 2024-06-19T16:34:14+01:00
Revert "Do uniq-renaming pass right at `codeGen`"

This reverts commit 74e9068aaaf736bf815a36bf74a0dde19a074a7a.

- - - - -
70ff49b7 by Rodrigo Mesquita at 2024-06-19T16:40:09+01:00
Reapply "Do uniq renaming before SRTs"

This reverts commit 682f89732fc2a95fa011f530c0c6922bf576d229.

- - - - -


4 changed files:

- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main.hs


Changes:

=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -19,6 +19,7 @@ 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
 
@@ -42,18 +43,27 @@ cmmPipeline
  :: Logger
  -> CmmConfig
  -> ModuleSRTInfo        -- Info about SRTs generated so far
+ -> DetUniqFM
  -> CmmGroup             -- Input C-- with Procedures
- -> IO (ModuleSRTInfo, CmmGroupSRTs) -- Output CPS transformed C--
+ -> IO (ModuleSRTInfo, (DetUniqFM, CmmGroupSRTs)) -- Output CPS transformed C--
 
-cmmPipeline logger cmm_config srtInfo prog = do
+cmmPipeline logger cmm_config srtInfo detRnEnv 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
+
+     -- 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 (rn_mapping, renamed_prog) = detRenameUniques detRnEnv prog -- TODO: if gopt Opt_DeterministicObjects dflags
+
+     (procs, data_) <- {-# SCC "tops" #-} partitionWithM (cpsTop logger platform cmm_config) renamed_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)
 
-     return (srtInfo, cmms)
+     return (srtInfo, (rn_mapping, cmms))
 
 
 -- | The Cmm pipeline for a single 'CmmDecl'. Returns:


=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -39,7 +39,6 @@ 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
 
@@ -96,23 +95,12 @@ 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 renamed_cmm_stream
-                    else renamed_cmm_stream
+                    then Stream.mapM do_lint cmm_stream
+                    else cmm_stream
 
               do_lint cmm = withTimingSilent logger
                   (text "CmmLint"<+>brackets (ppr this_mod))


=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -35,6 +35,7 @@ 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)]
@@ -211,7 +212,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) ipeCmmGroup
+  (_, (_, ipeCmmGroupSRTs)) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) emptyDetUFM ipeCmmGroup
   Stream.yield ipeCmmGroupSRTs
 
   ipeStub <-


=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -300,6 +300,8 @@ 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
 
 
 {- **********************************************************************
@@ -2085,6 +2087,7 @@ 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)
 
@@ -2094,8 +2097,10 @@ 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]
-        cmmgroup <-
-          concatMapM (\cmm -> snd <$> cmmPipeline logger cmm_config (emptySRT cmm_mod) [cmm]) cmm
+        (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)
 
         unless (null cmmgroup) $
           putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm"
@@ -2193,9 +2198,10 @@ doCodeGen hsc_env this_mod denv data_tycons
 
         pipeline_stream :: Stream IO CmmGroupSRTs CmmCgInfos
         pipeline_stream = do
-          ((mod_srt_info, ipes, ipe_stats), lf_infos) <-
+          ((mod_srt_info, ipes, ipe_stats, rn_mapping), lf_infos) <-
             {-# SCC "cmmPipeline" #-}
-            Stream.mapAccumL_ (pipeline_action logger cmm_config) (emptySRT this_mod, M.empty, mempty) ppr_stream1
+            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)
           let nonCaffySet = srtMapNonCAFs (moduleSRTMap mod_srt_info)
           cmmCgInfos <- generateCgIPEStub hsc_env this_mod denv (nonCaffySet, lf_infos, ipes, ipe_stats)
           return cmmCgInfos
@@ -2203,11 +2209,11 @@ doCodeGen hsc_env this_mod denv data_tycons
         pipeline_action
           :: Logger
           -> CmmConfig
-          -> (ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
+          -> (ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats, DetUniqFM)
           -> CmmGroup
-          -> 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
+          -> 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
 
           -- If -finfo-table-map is enabled, we precompute a map from info
           -- tables to source locations. See Note [Mapping Info Tables to Source
@@ -2218,7 +2224,7 @@ doCodeGen hsc_env this_mod denv data_tycons
             else
               return (ipes, stats)
 
-          return ((mod_srt_info', ipes', stats'), cmm_srts)
+          return ((mod_srt_info', ipes', stats', rn_mapping), cmm_srts)
 
         dump2 a = do
           unless (null a) $



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51fd4fe4b24520251cbfc2787e244a83b497730e...70ff49b7efc8c1fca46cba6eff630c5d39a99213

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51fd4fe4b24520251cbfc2787e244a83b497730e...70ff49b7efc8c1fca46cba6eff630c5d39a99213
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/20240620/f5f3019c/attachment-0001.html>


More information about the ghc-commits mailing list