[Git][ghc/ghc][wip/romes/12935] 2 commits: Local test script tweaks
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Jun 17 14:32:35 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
b52063dd by Rodrigo Mesquita at 2024-05-28T11:00:06+01:00
Local test script tweaks
- - - - -
db38b635 by Rodrigo Mesquita at 2024-06-17T15:32:27+01:00
Do uniq renaming before SRTs
- - - - -
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
- testsuite/tests/determinism/object/check.sh
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/Cmm/UniqueRenamer.hs
=====================================
@@ -76,7 +76,7 @@ renameDetUniq uq = do
return det_uniq
-- Rename local symbols deterministically (in order of appearance)
-detRenameUniques :: DetUniqFM -> RawCmmGroup -> (DetUniqFM, RawCmmGroup)
+detRenameUniques :: DetUniqFM -> CmmGroup -> (DetUniqFM, CmmGroup)
detRenameUniques dufm group = swap $ runState (mapM uniqRename group) dufm
-- The most important function here, which does the actual renaming.
@@ -112,12 +112,33 @@ instance UniqRenamable CmmTickScope where
-- * Traversals from here on out
+-- ROMES:TODO: Delete RawCmmStatics instanceS?
instance UniqRenamable (GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph) where
uniqRename (CmmProc h lbl regs g)
= CmmProc <$> uniqRename h <*> uniqRename lbl <*> mapM uniqRename regs <*> uniqRename g
uniqRename (CmmData sec d)
= CmmData <$> uniqRename sec <*> uniqRename d
+instance UniqRenamable (GenCmmDecl CmmStatics CmmTopInfo CmmGraph) where
+ uniqRename (CmmProc h lbl regs g)
+ = CmmProc <$> uniqRename h <*> uniqRename lbl <*> mapM uniqRename regs <*> uniqRename g
+ uniqRename (CmmData sec d)
+ = CmmData <$> uniqRename sec <*> uniqRename d
+
+instance UniqRenamable CmmTopInfo where
+ uniqRename TopInfo{info_tbls, stack_info}
+ = TopInfo <$> uniqRename info_tbls <*> pure stack_info
+
+instance UniqRenamable CmmStatics where
+ uniqRename (CmmStatics clbl info ccs lits1 lits2)
+ = CmmStatics <$> uniqRename clbl <*> uniqRename info <*> pure ccs <*> mapM uniqRename lits1 <*> mapM uniqRename lits2
+ uniqRename (CmmStaticsRaw lbl sts)
+ = CmmStaticsRaw <$> uniqRename lbl <*> mapM uniqRename sts
+
+instance UniqRenamable CmmInfoTable where
+ uniqRename CmmInfoTable{cit_lbl, cit_rep, cit_prof, cit_srt, cit_clo}
+ = CmmInfoTable <$> uniqRename cit_lbl <*> pure cit_rep <*> pure cit_prof <*> uniqRename cit_srt <*> pure cit_clo
+
instance UniqRenamable Section where
uniqRename (Section ty lbl) = Section ty <$> uniqRename lbl
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -95,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
=====================================
@@ -298,6 +298,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
{- **********************************************************************
@@ -2076,6 +2078,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)
@@ -2085,8 +2088,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"
@@ -2178,9 +2183,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
@@ -2188,11 +2194,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
@@ -2203,7 +2209,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) $
=====================================
testsuite/tests/determinism/object/check.sh
=====================================
@@ -1,6 +1,6 @@
#!/bin/sh
-set -e
+# set -e
if test -z "$1"
then
@@ -34,7 +34,7 @@ compareObjs() {
# Compare the object dumps except for the first line which prints the file path
$OBJDUMP $2 Cabal-3.12.0.0/out1/$o | tail -n+2 > dump1
$OBJDUMP $2 Cabal-3.12.0.0/out2/$o | tail -n+2 > dump2
- diff dump1 dump2
+ diff dump1 dump2 && echo "OK"
echo "--------------------------------------------------------------------------------"
done
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd74409aa3889dc7a4353b8e1687721448d72116...db38b635d626106e40b3ab18091e0a24046c30c5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd74409aa3889dc7a4353b8e1687721448d72116...db38b635d626106e40b3ab18091e0a24046c30c5
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/20240617/18c0825e/attachment-0001.html>
More information about the ghc-commits
mailing list