[Git][ghc/ghc][wip/romes/12935] 3 commits: Revert "Do uniq renaming before SRTs"

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Tue Jun 18 11:32:09 UTC 2024



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


Commits:
882530a0 by Rodrigo Mesquita at 2024-06-17T16:33:36+01:00
Revert "Do uniq renaming before SRTs"

This reverts commit db38b635d626106e40b3ab18091e0a24046c30c5.

- - - - -
d8aea116 by Rodrigo Mesquita at 2024-06-18T12:07:18+01:00
Do on CmmGroup

- - - - -
4a375647 by Rodrigo Mesquita at 2024-06-18T12:31:52+01:00
Do uniq-renaming pass right at `codeGen`

- - - - -


5 changed files:

- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Data/Stream.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
 
@@ -43,27 +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 srtInfo detRnEnv 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
-
-     -- 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
+     (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)
 
-     return (srtInfo, (rn_mapping, cmms))
+     return (srtInfo, cmms)
 
 
 -- | The Cmm pipeline for a single 'CmmDecl'. Returns:


=====================================
compiler/GHC/Data/Stream.hs
=====================================
@@ -60,6 +60,7 @@ newtype Stream m a b =
                                         (a -> m r') -- For fusing calls to `map` and `mapM`
                                      -> (b -> StreamS m r' r)  -- For fusing `>>=`
                                      -> StreamS m r' r }
+-- romes:TODO: I suppose this lends itself well to parallelism? Perhaps we could make Stream be as parallel as possible?
 
 runStream :: Applicative m => Stream m r' r -> StreamS m r' r
 runStream st = runStreamInternal st pure Done


=====================================
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
=====================================
@@ -298,8 +298,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
 
 
 {- **********************************************************************
@@ -2078,7 +2076,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)
 
@@ -2088,10 +2085,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"
@@ -2183,10 +2178,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
@@ -2194,11 +2188,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
@@ -2209,7 +2203,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
=====================================
@@ -67,6 +67,7 @@ import System.IO.Unsafe
 import qualified Data.ByteString as BS
 import Data.IORef
 import GHC.Utils.Panic
+import GHC.Cmm.UniqueRenamer
 
 codeGen :: Logger
         -> TmpFs
@@ -79,6 +80,7 @@ codeGen :: Logger
         -> Stream IO CmmGroup ModuleLFInfos       -- Output as a stream, so codegen can
                                        -- be interleaved with output
 
+-- romes:TODO: it looks like we could do a lot of this in parallel...
 codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
         cost_centre_info stg_binds hpc_info
   = do  {     -- cg: run the code generator, and yield the resulting CmmGroup
@@ -86,18 +88,29 @@ 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 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)
+                         let ((a, cmm),st') = runC cfg fstate st (getCmm fcode)
 
                          -- 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
+
+                         -- 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
+                         rn_mapping <- liftIO $ readIORef uniqRnRef
+                         let (rn_mapping', renamed_cmm) = detRenameUniques rn_mapping cmm -- todo: if gopt Opt_DeterministicObjects dflags
+                         writeIORef uniqRnRef $! rn_mapping'
+
+                         return (a, renamed_cmm)
                 yield cmm
                 return a
 
@@ -138,6 +151,8 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
                 | otherwise
                 = mkNameEnv (Prelude.map extractInfo (nonDetEltsUFM cg_id_infos))
 
+        ; rn_mapping <- liftIO $ readIORef uniqRnRef
+        ; liftIO $ debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping)
         ; return generatedInfo
         }
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db38b635d626106e40b3ab18091e0a24046c30c5...4a3756478fb791071c75c5d6b9393aa4353fcaa1

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db38b635d626106e40b3ab18091e0a24046c30c5...4a3756478fb791071c75c5d6b9393aa4353fcaa1
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/20240618/ebb36a97/attachment-0001.html>


More information about the ghc-commits mailing list