[Git][ghc/ghc][wip/romes/12935] 2 commits: debug
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Fri Jun 28 15:21:54 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
e605aa32 by Rodrigo Mesquita at 2024-06-28T13:30:03+01:00
debug
- - - - -
4192c48c by Rodrigo Mesquita at 2024-06-28T14:22:37+01:00
SRT generation using deterministic uniq supply
- - - - -
7 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main.hs
- testsuite/tests/determinism/object/check-standalone.sh
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1853,12 +1853,15 @@ returns True.
-- renamed, eg uniques of local symbols or of system names.
-- See Note [....TODO]
-- ROMES:TODO: We can do less work here, like, do we really need to rename AsmTempLabel, SRTLabel, LocalBlockLabel?
+-- however, the input to layout must be deterministic to produce deterministic layout.
+-- Which means we could avoid renaming it here, as long as we guarantee the labels are produced deterministically (which we could, perhaps by using a det supply in fcode)
mapInternalNonDetUniques :: Applicative m => (Unique -> m Unique) -> CLabel -> m CLabel
mapInternalNonDetUniques f = \case
IdLabel name cafInfo idLabelInfo -> IdLabel . setNameUnique name <$> f (nameUnique name) <*> pure cafInfo <*> pure idLabelInfo
cl at CmmLabel{} -> pure cl
-- ROMES:TODO: what about `RtsApFast NonDetFastString`?
RtsLabel rtsLblInfo -> pure $ RtsLabel rtsLblInfo
+ -- Even if we can't get away with not renaming, we could forget these local ones right after renaming this block
LocalBlockLabel unique -> LocalBlockLabel <$> f unique
fl at ForeignLabel{} -> pure fl
AsmTempLabel unique -> AsmTempLabel <$> f unique
=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -882,15 +882,17 @@ anyCafRefs caf_infos = case any mayHaveCafRefs caf_infos of
doSRTs
:: CmmConfig
-> ModuleSRTInfo
+ -> DUniqSupply
-> [(CAFEnv, [CmmDecl])] -- ^ 'CAFEnv's and 'CmmDecl's for code blocks
-> [(CAFSet, CmmDataDecl)] -- ^ static data decls and their 'CAFSet's
- -> IO (ModuleSRTInfo, [CmmDeclSRTs])
+ -> IO (ModuleSRTInfo, DUniqSupply, [CmmDeclSRTs])
-doSRTs cfg moduleSRTInfo procs data_ = do
+doSRTs cfg moduleSRTInfo dus procs data_ = do
-- Use local namespace 'u' here.
-- See Note [Cmm Local Deterministic Uniques]
- let runUDSM x = let (a,b) = runUniqueDSM 'u' 1 x in pprTrace "doSRTS" (ppr b) a
+ -- in the future, set tag before usign DUniqueSupply
+ let runUDSM = runUniqueDSM 'u' dus
let profile = cmmProfile cfg
@@ -943,7 +945,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
, CafInfo -- Whether the group has CAF references
) ]
- (result, moduleSRTInfo') =
+ ((result, moduleSRTInfo'), dus') =
runUDSM $
flip runStateT moduleSRTInfo $ do
nonCAFs <- mapM (doSCC cfg staticFuns static_data_env) sccs
@@ -984,7 +986,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
CmmProc void _ _ _ -> case void of)
(moduleSRTMap moduleSRTInfo') data_
- return (moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, srt_decls ++ decls')
+ return (moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, dus', srt_decls ++ decls')
-- | Build the SRT for a strongly-connected component of blocks.
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -30,6 +30,7 @@ import GHC.Utils.Misc ( partitionWithM )
import GHC.Platform
import Control.Monad
+import GHC.Cmm.UniqueRenamer
-----------------------------------------------------------------------------
-- | Top level driver for C-- pipeline
@@ -42,18 +43,19 @@ cmmPipeline
:: Logger
-> CmmConfig
-> ModuleSRTInfo -- Info about SRTs generated so far
+ -> DUniqSupply
-> CmmGroup -- Input C-- with Procedures
- -> IO (ModuleSRTInfo, CmmGroupSRTs) -- Output CPS transformed C--
+ -> IO (ModuleSRTInfo, DUniqSupply, CmmGroupSRTs) -- Output CPS transformed C--
-cmmPipeline logger cmm_config srtInfo prog = do
- let forceRes (info, group) = info `seq` foldr seq () group
+cmmPipeline logger cmm_config srtInfo dus prog = do
+ let forceRes (info, us, group) = info `seq` us `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_
+ (procs, data_) <- {-# SCC "tops" #-} partitionWithM (cpsTop logger platform cmm_config {-TODO: dus argument too -}) prog
+ (srtInfo, dus, cmms) <- {-# SCC "doSRTs" #-} doSRTs cmm_config srtInfo dus procs data_
dumpWith logger Opt_D_dump_cmm_cps "Post CPS Cmm" FormatCMM (pdoc platform cmms)
- return (srtInfo, cmms)
+ return (srtInfo, dus, cmms)
-- | The Cmm pipeline for a single 'CmmDecl'. Returns:
--
@@ -354,6 +356,7 @@ generator later.
-}
+-- ROMESTODO: MAKE THIS DETERMINISTIC!!!!!!
runUniqSM :: UniqSM a -> IO a
runUniqSM m = do
us <- mkSplitUniqSupply 'u'
=====================================
compiler/GHC/Cmm/UniqueRenamer.hs
=====================================
@@ -72,7 +72,7 @@ renameDetUniq uq = do
Nothing -> do
new_w <- gets supply -- New deterministic unique in this `DetRnM`
let (tag, _) = unpkUnique uq
- det_uniq = mkUnique tag new_w
+ det_uniq = mkUnique 'Q' new_w
modify' (\DetUniqFM{mapping, supply} ->
-- Update supply and mapping
DetUniqFM
@@ -113,8 +113,8 @@ instance UniqRenamable CLabel where
uniqRename = detRenameCLabel
instance UniqRenamable LocalReg where
- -- uniqRename (LocalReg uq t) = LocalReg <$> renameDetUniq uq <*> pure t
- uniqRename (LocalReg uq t) = pure $ LocalReg uq t
+ uniqRename (LocalReg uq t) = LocalReg <$> renameDetUniq uq <*> pure t
+ -- uniqRename (LocalReg uq t) = pure $ LocalReg uq t
-- ROMES:TODO: This has unique r1, we're debugging. this may still be a source of non determinism.
instance UniqRenamable Label where
@@ -126,7 +126,13 @@ instance UniqRenamable CmmTickScope where
instance (UniqRenamable a, UniqRenamable b) => UniqRenamable (GenCmmDecl a b CmmGraph) where
uniqRename (CmmProc h lbl regs g)
- = CmmProc <$> uniqRename h <*> uniqRename lbl <*> uniqRename regs <*> uniqRename g
+ = do
+ g' <- uniqRename g
+ regs' <- uniqRename regs
+ lbl' <- uniqRename lbl
+ --- rename h last!!!
+ h' <- uniqRename h
+ return $ CmmProc h' lbl' regs' g'
uniqRename (CmmData sec d)
= CmmData <$> uniqRename sec <*> uniqRename d
@@ -178,6 +184,7 @@ instance UniqRenamable CmmLit where
CmmBlock bid -> CmmBlock <$> uniqRename bid
CmmHighStackMark -> pure CmmHighStackMark
+-- TODO::: VERY BAD!!! This isn't deterministic since the key is non-deterministic thus the order in which we rename is non deterministic
instance UniqRenamable a {- for 'Body' and on 'RawCmmStatics' -}
=> UniqRenamable (LabelMap a) where
uniqRename lm = mapFromListWith panicMapKeysNotInjective <$> traverse (\(l,x) -> (,) <$> uniqRename l <*> uniqRename x) (mapToList lm)
@@ -263,9 +270,11 @@ instance (UniqRenamable a) => UniqRenamable (Maybe a) where
uniqRename Nothing = pure Nothing
uniqRename (Just x) = Just <$> uniqRename x
+-- TODO::: BAD!!! This won't be deterministic if the key is non-deterministic because the order in which we rename is non deterministic
instance (Ord a, UniqRenamable a, UniqRenamable b) => UniqRenamable (M.Map a b) where
uniqRename m = M.fromListWith panicMapKeysNotInjective <$> traverse (\(l,x) -> (,) <$> uniqRename l <*> uniqRename x) (M.toList m)
+-- TODO::: BAD!!! This won't be deterministic if the key is non-deterministic because the order in which we rename is non deterministic
instance (Ord a, UniqRenamable a) => UniqRenamable (S.Set a) where
-- Because of renaming being injective the resulting set should have the same
-- size as the intermediate list.
=====================================
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
{-
Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
@@ -197,9 +198,10 @@ generateCgIPEStub
, ModuleLFInfos
, Map CmmInfoTable (Maybe IpeSourceLocation)
, IPEStats
+ , DUniqSupply
)
-> Stream IO CmmGroupSRTs CmmCgInfos
-generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesWithTickishes, initStats) = do
+generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesWithTickishes, initStats, dus) = do
let dflags = hsc_dflags hsc_env
platform = targetPlatform dflags
logger = hsc_logger hsc_env
@@ -211,7 +213,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) dus ipeCmmGroup
Stream.yield ipeCmmGroupSRTs
ipeStub <-
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -300,6 +300,7 @@ import GHC.StgToCmm.Utils (IPEStats)
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Cmm.Config (CmmConfig)
+import GHC.Cmm.UniqueRenamer
{- **********************************************************************
@@ -2094,8 +2095,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
+ cmmgroup <- concat . snd <$>
+ mapAccumLM (\(msrt0, dus0) cmm -> do
+ (msrt1, dus1, cmm') <- cmmPipeline logger cmm_config msrt0 dus0 [cmm]
+ return ((msrt1, dus1), cmm')) (emptySRT cmm_mod, 1) cmm
unless (null cmmgroup) $
putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm"
@@ -2193,21 +2196,21 @@ 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, dus), 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, 1) ppr_stream1
let nonCaffySet = srtMapNonCAFs (moduleSRTMap mod_srt_info)
- cmmCgInfos <- generateCgIPEStub hsc_env this_mod denv (nonCaffySet, lf_infos, ipes, ipe_stats)
+ cmmCgInfos <- generateCgIPEStub hsc_env this_mod denv (nonCaffySet, lf_infos, ipes, ipe_stats, dus)
return cmmCgInfos
pipeline_action
:: Logger
-> CmmConfig
- -> (ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
+ -> (ModuleSRTInfo, Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats, DUniqSupply)
-> 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, DUniqSupply), CmmGroupSRTs)
+ pipeline_action logger cmm_config (mod_srt_info, ipes, stats, dus) cmm_group = do
+ (mod_srt_info', dus', cmm_srts) <- cmmPipeline logger cmm_config mod_srt_info dus 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 +2221,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', dus'), cmm_srts)
dump2 a = do
unless (null a) $
=====================================
testsuite/tests/determinism/object/check-standalone.sh
=====================================
@@ -8,6 +8,6 @@ fi
rm -rf objs1 objs2
cabal get Cabal-3.12.0.0
-cabal build -w $1 --ghc-options="-fforce-recomp -j4" --ghc-options=-odir=out1 Cabal
-cabal build -w $1 --ghc-options="-fforce-recomp -j4" --ghc-options=-odir=out2 Cabal
+cabal build -w $1 --ghc-options="-fforce-recomp -j4 -ddump-to-file -ddump-asm -ddump-cmm -ddump-stg-final" --ghc-options=-odir=out1 Cabal
+cabal build -w $1 --ghc-options="-fforce-recomp -j4 -dinitial-unique=16777215 -dunique-increment=-1 -ddump-to-file -ddump-asm -ddump-cmm -ddump-stg-final" --ghc-options=-odir=out2 Cabal
./check.sh darwin
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/839d6225e0ff437397ab03c80b4e7a134efca434...4192c48c2cb3171e00249ad09d8313377e096101
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/839d6225e0ff437397ab03c80b4e7a134efca434...4192c48c2cb3171e00249ad09d8313377e096101
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/20240628/28c09906/attachment-0001.html>
More information about the ghc-commits
mailing list