compiler/GHC/Cmm.hs

@@ -12,22 +12,28 @@
 
 module GHC.Cmm (
      -- * Cmm top-level datatypes
+     DCmmGroup,
      CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,
-     CmmDecl, CmmDeclSRTs, GenCmmDecl(..),
-     CmmDataDecl, cmmDataDeclCmmDecl,
-     CmmGraph, GenCmmGraph(..),
+     CmmDecl, DCmmDecl, CmmDeclSRTs, GenCmmDecl(..),
+     CmmDataDecl, cmmDataDeclCmmDecl, DCmmGraph,
+     CmmGraph, GenCmmGraph, GenGenCmmGraph(..),
      toBlockMap, revPostorder, toBlockList,
      CmmBlock, RawCmmDecl,
      Section(..), SectionType(..),
      GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),
      SectionProtection(..), sectionProtection,
 
+     DWrap(..), unDeterm, removeDeterm, removeDetermDecl, removeDetermGraph,
+
      -- ** Blocks containing lists
      GenBasicBlock(..), blockId,
      ListGraph(..), pprBBlock,
 
      -- * Info Tables
-     CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
+     GenCmmTopInfo(..)
+     , DCmmTopInfo
+     , CmmTopInfo
+     , CmmStackInfo(..), CmmInfoTable(..), topInfoTable, topInfoTableD,
      ClosureTypeInfo(..),
      ProfilingInfo(..), ConstrDescription,
 
@@ -74,6 +80,8 @@ import qualified Data.ByteString as BS
 type CmmProgram = [CmmGroup]
 
 type GenCmmGroup d h g = [GenCmmDecl d h g]
+-- | Cmm group after STG generation
+type DCmmGroup    = GenCmmGroup CmmStatics    DCmmTopInfo              DCmmGraph
 -- | Cmm group before SRT generation
 type CmmGroup     = GenCmmGroup CmmStatics    CmmTopInfo               CmmGraph
 -- | Cmm group with SRTs
@@ -117,6 +125,7 @@ instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platfor
       => OutputableP Platform (GenCmmDecl d info i) where
     pdoc = pprTop
 
+type DCmmDecl    = GenCmmDecl CmmStatics DCmmTopInfo DCmmGraph
 type CmmDecl     = GenCmmDecl CmmStatics    CmmTopInfo CmmGraph
 type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
 type CmmDataDecl = GenCmmDataDecl CmmStatics
@@ -139,7 +148,11 @@ type RawCmmDecl
 -----------------------------------------------------------------------------
 
 type CmmGraph = GenCmmGraph CmmNode
-data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
+type DCmmGraph = GenGenCmmGraph DWrap CmmNode
+
+type GenCmmGraph n = GenGenCmmGraph LabelMap n
+
+data GenGenCmmGraph s n = CmmGraph { g_entry :: BlockId, g_graph :: Graph' s Block n C C }
 type CmmBlock = Block CmmNode C C
 
 instance OutputableP Platform CmmGraph where
@@ -171,8 +184,16 @@ toBlockList g = mapElems $ toBlockMap g
 
 -- | CmmTopInfo is attached to each CmmDecl (see defn of CmmGroup), and contains
 -- the extra info (beyond the executable code) that belongs to that CmmDecl.
-data CmmTopInfo   = TopInfo { info_tbls  :: LabelMap CmmInfoTable
-                            , stack_info :: CmmStackInfo }
+data GenCmmTopInfo f = TopInfo { info_tbls  :: f CmmInfoTable
+                               , stack_info :: CmmStackInfo }
+
+newtype DWrap a = DWrap [(BlockId, a)]
+
+unDeterm :: DWrap a -> [(BlockId, a)]
+unDeterm (DWrap f) = f
+
+type DCmmTopInfo = GenCmmTopInfo DWrap
+type CmmTopInfo  = GenCmmTopInfo LabelMap
 
 instance OutputableP Platform CmmTopInfo where
     pdoc = pprTopInfo
@@ -182,7 +203,12 @@ pprTopInfo platform (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
   vcat [text "info_tbls: " <> pdoc platform info_tbl,
         text "stack_info: " <> ppr stack_info]
 
-topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
+topInfoTableD :: GenCmmDecl a DCmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
+topInfoTableD (CmmProc infos _ _ g) = case (info_tbls infos) of
+                                          DWrap xs -> lookup (g_entry g) xs
+topInfoTableD _                     = Nothing
+
+topInfoTable :: GenCmmDecl a CmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
 topInfoTable (CmmProc infos _ _ g) = mapLookup (g_entry g) (info_tbls infos)
 topInfoTable _                     = Nothing
 
@@ -237,6 +263,7 @@ data ProfilingInfo
   = NoProfilingInfo
   | ProfilingInfo ByteString ByteString -- closure_type, closure_desc
   deriving (Eq, Ord)
+
 -----------------------------------------------------------------------------
 --              Static Data
 -----------------------------------------------------------------------------
@@ -328,6 +355,61 @@ instance OutputableP Platform (GenCmmStatics a) where
 type CmmStatics    = GenCmmStatics 'False
 type RawCmmStatics = GenCmmStatics 'True
 
+{-
+-----------------------------------------------------------------------------
+--              Deterministic Cmm / Info Tables
+-----------------------------------------------------------------------------
+
+Note [DCmmGroup vs CmmGroup or: Deterministic Info Tables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Consulting Note [Object determinism] one will learn that in order to produce
+deterministic objects just after cmm is produced we perform a renaming pass which
+provides fresh uniques for all unique-able things in the input Cmm.
+
+After this point, we use a deterministic unique supply (an incrementing counter)
+so any resulting labels which make their way into object code have a deterministic name.
+
+A key assumption to this process is that the input is deterministic modulo the uniques
+and the order that bindings appear in the definitions is the same.
+
+CmmGroup uses LabelMap in two places:
+
+* In CmmProc for info tables
+* In CmmGraph for the blocks of the graph
+
+LabelMap is not a deterministic strucutre, so traversing a LabelMap can process
+elements in different order (depending on the given uniques).
+
+Therefore before we do the renaming we need to use a deterministic strucutre, one
+which we can traverse in a guaranteed order. A list does the job perfectly.
+
+Once the renaming happens it is converted back into a LabelMap, which is now deterministic
+due to the uniques being generated and assigned in a deterministic manner.
+
+We prefer using the renamed LabelMap rather than the list in the rest of the
+code generation because it is much more efficient than lists for the needs of
+the code generator.
+-}
+
+-- Converting out of deterministic Cmm
+
+removeDeterm :: DCmmGroup -> CmmGroup
+removeDeterm = map removeDetermDecl
+
+removeDetermDecl :: DCmmDecl -> CmmDecl
+removeDetermDecl (CmmProc h e r g) = CmmProc (removeDetermTop h) e r (removeDetermGraph g)
+removeDetermDecl (CmmData a b) = CmmData a b
+
+removeDetermTop :: DCmmTopInfo -> CmmTopInfo
+removeDetermTop (TopInfo a b) = TopInfo (mapFromList $ unDeterm a) b
+
+removeDetermGraph :: DCmmGraph -> CmmGraph
+removeDetermGraph (CmmGraph x y) =
+  let y' = case y of
+            GMany a (DWrap b) c -> GMany a (mapFromList b) c
+  in CmmGraph x y'
+
 -- -----------------------------------------------------------------------------
 -- Basic blocks consisting of lists
 

compiler/GHC/Cmm/CLabel.hs

@@ -139,6 +139,7 @@ module GHC.Cmm.CLabel (
         CStubLabel (..),
         cStubLabel,
         fromCStubLabel,
+        mapInternalNonDetUniques
     ) where
 
 import GHC.Prelude
@@ -346,15 +347,23 @@ newtype NeedExternDecl
 -- This is non-deterministic but we do not currently support deterministic
 -- code-generation. See Note [Unique Determinism and code generation]
 instance Ord CLabel where
+  compare (IdLabel a1 b1 c1)
+          (IdLabel a2 b2 c2)
+          | isExternalName a1, isExternalName a2 = stableNameCmp a1 a2 S.<> compare b1 b2 S.<> compare c1 c2
+          | isExternalName a1 = GT
+          | isExternalName a2 = LT
+
   compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =
+    -- Comparing names here should deterministic because all unique should have
+    -- been renamed deterministically, and external names compared above.
     compare a1 a2 S.<>
     compare b1 b2 S.<>
     compare c1 c2
   compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) =
     compare a1 a2 S.<>
     compare b1 b2 S.<>
-    -- This non-determinism is "safe" in the sense that it only affects object code,
-    -- which is currently not covered by GHC's determinism guarantees. See #12935.
+    -- This is not non-deterministic because the uniques have been deterministically renamed.
+    -- See Note [Object determinism]
     uniqCompareFS c1 c2 S.<>
     compare d1 d2
   compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
@@ -1906,3 +1915,35 @@ fromCStubLabel (CStubLabel {csl_is_initializer, csl_module, csl_name}) =
       if csl_is_initializer
       then MLK_Initializer
       else MLK_Finalizer
+
+-- | A utility for renaming uniques in CLabels to produce deterministic object.
+-- Note that not all Uniques are mapped over. Only those that can be safely alpha
+-- renamed, e.g. uniques of local symbols, but not of external ones.
+-- See Note [Renaming uniques deterministically].
+mapInternalNonDetUniques :: Applicative m => (Unique -> m Unique) -> CLabel -> m CLabel
+-- todo: Can we do less work here, e.g., do we really need to rename AsmTempLabel, LocalBlockLabel?
+mapInternalNonDetUniques f x = case x of
+  IdLabel name cafInfo idLabelInfo
+    | not (isExternalName name) -> IdLabel . setNameUnique name <$> f (nameUnique name) <*> pure cafInfo <*> pure idLabelInfo
+    | otherwise -> pure x
+  cl@CmmLabel{} -> pure cl
+  RtsLabel rtsLblInfo -> pure $ RtsLabel rtsLblInfo
+  LocalBlockLabel unique -> LocalBlockLabel <$> f unique
+  fl@ForeignLabel{} -> pure fl
+  AsmTempLabel unique -> AsmTempLabel <$> f unique
+  AsmTempDerivedLabel clbl fs -> AsmTempDerivedLabel <$> mapInternalNonDetUniques f clbl <*> pure fs
+  StringLitLabel unique -> StringLitLabel <$> f unique
+  CC_Label  cc -> pure $ CC_Label cc
+  CCS_Label ccs -> pure $ CCS_Label ccs
+  IPE_Label ipe@InfoProvEnt{infoTablePtr} ->
+    (\cl' -> IPE_Label ipe{infoTablePtr = cl'}) <$> mapInternalNonDetUniques f infoTablePtr
+  ml@ModuleLabel{} -> pure ml
+  DynamicLinkerLabel dlli clbl -> DynamicLinkerLabel dlli <$> mapInternalNonDetUniques f clbl
+  PicBaseLabel -> pure PicBaseLabel
+  DeadStripPreventer clbl -> DeadStripPreventer <$> mapInternalNonDetUniques f clbl
+  HpcTicksLabel mod -> pure $ HpcTicksLabel mod
+  SRTLabel unique -> SRTLabel <$> f unique
+  LargeBitmapLabel unique -> LargeBitmapLabel <$> f unique
+-- This is called *a lot* if renaming Cmm uniques, and won't specialise without this pragma:
+{-# INLINABLE mapInternalNonDetUniques #-}
+

compiler/GHC/Cmm/Dataflow/Graph.hs

@@ -26,10 +26,10 @@ import GHC.Cmm.Dataflow.Block
 import Data.Kind
 
 -- | A (possibly empty) collection of closed/closed blocks
-type Body n = LabelMap (Block n C C)
+type Body s n = Body' s Block n
 
 -- | @Body@ abstracted over @block@
-type Body' block (n :: Extensibility -> Extensibility -> Type) = LabelMap (block n C C)
+type Body' s block (n :: Extensibility -> Extensibility -> Type) = s (block n C C)
 
 -------------------------------
 -- | Gives access to the anchor points for
@@ -46,13 +46,13 @@ instance NonLocal n => NonLocal (Block n) where
   successors (BlockCC _ _ n) = successors n
 
 
-emptyBody :: Body' block n
+emptyBody :: Body' LabelMap block n
 emptyBody = mapEmpty
 
-bodyList :: Body' block n -> [(Label,block n C C)]
+bodyList :: Body' LabelMap block n -> [(Label,block n C C)]
 bodyList body = mapToList body
 
-bodyToBlockList :: Body n -> [Block n C C]
+bodyToBlockList :: Body LabelMap n -> [Block n C C]
 bodyToBlockList body = mapElems body
 
 addBlock
@@ -72,18 +72,18 @@ addBlock block body = mapAlter add lbl body
 -- O/C, C/O, C/C).  A graph open at the entry has a single,
 -- distinguished, anonymous entry point; if a graph is closed at the
 -- entry, its entry point(s) are supplied by a context.
-type Graph = Graph' Block
+type Graph = Graph' LabelMap Block
 
 -- | @Graph'@ is abstracted over the block type, so that we can build
 -- graphs of annotated blocks for example (Compiler.Hoopl.Dataflow
 -- needs this).
-data Graph' block (n :: Extensibility -> Extensibility -> Type) e x where
-  GNil  :: Graph' block n O O
-  GUnit :: block n O O -> Graph' block n O O
+data Graph' s block (n :: Extensibility -> Extensibility -> Type) e x where
+  GNil  :: Graph' s block n O O
+  GUnit :: block n O O -> Graph' s block n O O
   GMany :: MaybeO e (block n O C)
-        -> Body' block n
+        -> Body' s block n
         -> MaybeO x (block n C O)
-        -> Graph' block n e x
+        -> Graph' s block n e x
 
 
 -- -----------------------------------------------------------------------------
@@ -91,26 +91,27 @@ data Graph' block (n :: Extensibility -> Extensibility -> Type) e x where
 
 -- | Maps over all nodes in a graph.
 mapGraph :: (forall e x. n e x -> n' e x) -> Graph n e x -> Graph n' e x
-mapGraph f = mapGraphBlocks (mapBlock f)
+mapGraph f = mapGraphBlocks mapMap (mapBlock f)
 
 -- | Function 'mapGraphBlocks' enables a change of representation of blocks,
 -- nodes, or both.  It lifts a polymorphic block transform into a polymorphic
 -- graph transform.  When the block representation stabilizes, a similar
 -- function should be provided for blocks.
-mapGraphBlocks :: forall block n block' n' e x .
-                  (forall e x . block n e x -> block' n' e x)
-               -> (Graph' block n e x -> Graph' block' n' e x)
+mapGraphBlocks :: forall s block n block' n' e x .
+                  (forall a b . (a -> b) -> s a -> s b)
+               -> (forall e x . block n e x -> block' n' e x)
+               -> (Graph' s block n e x -> Graph' s block' n' e x)
 
-mapGraphBlocks f = map
-  where map :: Graph' block n e x -> Graph' block' n' e x
+mapGraphBlocks f g = map
+  where map :: Graph' s block n e x -> Graph' s block' n' e x
         map GNil = GNil
-        map (GUnit b) = GUnit (f b)
-        map (GMany e b x) = GMany (fmap f e) (mapMap f b) (fmap f x)
+        map (GUnit b) = GUnit (g b)
+        map (GMany e b x) = GMany (fmap g e) (f g b) (fmap g x)
 
 -- -----------------------------------------------------------------------------
 -- Extracting Labels from graphs
 
-labelsDefined :: forall block n e x . NonLocal (block n) => Graph' block n e x
+labelsDefined :: forall block n e x . NonLocal (block n) => Graph' LabelMap block n e x
               -> LabelSet
 labelsDefined GNil      = setEmpty
 labelsDefined (GUnit{}) = setEmpty

compiler/GHC/Cmm/Graph.hs

@@ -73,12 +73,12 @@ data CgStmt
   | CgLast  (CmmNode O C)
   | CgFork  BlockId CmmAGraph CmmTickScope
 
-flattenCmmAGraph :: BlockId -> CmmAGraphScoped -> CmmGraph
+flattenCmmAGraph :: BlockId -> CmmAGraphScoped -> DCmmGraph
 flattenCmmAGraph id (stmts_t, tscope) =
     CmmGraph { g_entry = id,
                g_graph = GMany NothingO body NothingO }
   where
-  body = foldr addBlock emptyBody $ flatten id stmts_t tscope []
+  body = DWrap [(entryLabel b, b) | b <- flatten id stmts_t tscope [] ]
 
   --
   -- flatten: given an entry label and a CmmAGraph, make a list of blocks.
@@ -169,13 +169,13 @@ outOfLine      :: BlockId -> CmmAGraphScoped -> CmmAGraph
 outOfLine l (c,s) = unitOL (CgFork l c s)
 
 -- | allocate a fresh label for the entry point
-lgraphOfAGraph :: CmmAGraphScoped -> UniqDSM CmmGraph
+lgraphOfAGraph :: CmmAGraphScoped -> UniqDSM DCmmGraph
 lgraphOfAGraph g = do
   u <- getUniqueDSM
   return (labelAGraph (mkBlockId u) g)
 
 -- | use the given BlockId as the label of the entry point
-labelAGraph    :: BlockId -> CmmAGraphScoped -> CmmGraph
+labelAGraph    :: BlockId -> CmmAGraphScoped -> DCmmGraph
 labelAGraph lbl ag = flattenCmmAGraph lbl ag
 
 ---------- No-ops

compiler/GHC/Cmm/Info/Build.hs

@@ -9,6 +9,10 @@ module GHC.Cmm.Info.Build
   ( CAFSet, CAFEnv, cafAnal, cafAnalData
   , doSRTs, ModuleSRTInfo (..), emptySRT
   , SRTMap, srtMapNonCAFs
+
+  -- * Some internal bits
+  , SRTEntry(..)
+  , CAFfyLabel(..)
   ) where
 
 import GHC.Prelude hiding (succ)

compiler/GHC/Cmm/LayoutStack.hs

@@ -282,12 +282,18 @@ layout cfg procpoints liveness entry entry_args final_stackmaps final_sp_high bl
   where
     (updfr, cont_info)  = collectContInfo blocks
 
-    init_stackmap = mapSingleton entry StackMap{ sm_sp   = entry_args
-                                               , sm_args = entry_args
-                                               , sm_ret_off = updfr
-                                               , sm_regs = emptyUFM
-                                               }
-
+    init_stackmap = mapSingleton entry
+                      StackMap{ sm_sp   = entry_args
+                              , sm_args = entry_args
+                              , sm_ret_off = updfr
+                              , sm_regs = emptyUFM
+                              }
+
+    go :: [Block CmmNode C C]
+       -> LabelMap StackMap
+       -> StackLoc
+       -> [CmmBlock]
+       -> UniqDSM (LabelMap StackMap, StackLoc, [CmmBlock])
     go [] acc_stackmaps acc_hwm acc_blocks
       = return (acc_stackmaps, acc_hwm, acc_blocks)
 
@@ -1180,7 +1186,7 @@ lowerSafeForeignCall profile block
                                copyout <*>
                                mkLast jump, tscp)
 
-    case toBlockList graph' of
+    case toBlockList (removeDetermGraph graph') of
       [one] -> let (_, middle', last) = blockSplit one
                in return (blockJoin entry (middle `blockAppend` middle') last)
       _ -> panic "lowerSafeForeignCall0"

compiler/GHC/Cmm/Parser.y

@@ -278,6 +278,7 @@ import GHC.Parser.Lexer
 import GHC.Parser.Errors.Types
 import GHC.Parser.Errors.Ppr
 
+import GHC.Types.Unique.DSM
 import GHC.Types.CostCentre
 import GHC.Types.ForeignCall
 import GHC.Unit.Module
@@ -1575,7 +1576,7 @@ parseCmmFile :: CmmParserConfig
              -> Module
              -> HomeUnit
              -> FilePath
-             -> IO (Messages PsMessage, Messages PsMessage, Maybe (CmmGroup, [InfoProvEnt]))
+             -> IO (Messages PsMessage, Messages PsMessage, Maybe (DCmmGroup, [InfoProvEnt]))
 parseCmmFile cmmpConfig this_mod home_unit filename = do
   buf <- hGetStringBuffer filename
   let
@@ -1595,11 +1596,17 @@ parseCmmFile cmmpConfig this_mod home_unit filename = do
               ((), cmm) <- getCmm $ unEC code "global" (initEnv (pdProfile pdConfig)) [] >> return ()
               -- See Note [Mapping Info Tables to Source Positions] (IPE Maps)
               let used_info
-                    | do_ipe    = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTable cmm)
+                    | do_ipe    = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTableD cmm)
                     | otherwise = []
                     where
                       do_ipe = stgToCmmInfoTableMap $ cmmpStgToCmmConfig cmmpConfig
-              ((), cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info
+              -- We need to pass a deterministic unique supply to generate IPE
+              -- symbols deterministically. The symbols created by
+              -- emitIpeBufferListNode must all be local to the object (see
+              -- comment on its definition). If the symbols weren't local, using a
+              -- counter starting from zero for every Cmm file would cause
+              -- conflicts when compiling more than one Cmm file together.
+              (_, cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info (initDUniqSupply 'P' 0)
               return (cmm ++ cmm2, used_info)
             (cmm, _) = runC (cmmpStgToCmmConfig cmmpConfig) fstate st fcode
             (warnings,errors) = getPsMessages pst

compiler/GHC/Cmm/Pipeline.hs

@@ -59,7 +59,6 @@ cmmPipeline logger cmm_config srtInfo prog dus0 = do
 
      return ((srtInfo, cmms), dus)
 
-
 -- | The Cmm pipeline for a single 'CmmDecl'. Returns:
 --
 --   - in the case of a 'CmmProc': 'Left' of the resulting (possibly
@@ -81,7 +80,7 @@ cpsTop logger platform cfg dus proc =
       --
       CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
            return $ cmmCfgOptsProc splitting_proc_points proc
-      dump Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
+      dump Opt_D_dump_cmm_cfg "Post control-flow optimisations (1)" g
 
       let !TopInfo {stack_info=StackInfo { arg_space = entry_off
                                          , do_layout = do_layout }} = h
@@ -177,7 +176,7 @@ cpsTop logger platform cfg dus proc =
                     else g
       g <- return $ map (removeUnreachableBlocksProc platform) g
            -- See Note [unreachable blocks]
-      dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
+      dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations (2)" g
 
       return (dus, Left (cafEnv, g))
 

compiler/GHC/Cmm/Switch.hs

@@ -4,7 +4,7 @@ module GHC.Cmm.Switch (
      SwitchTargets,
      mkSwitchTargets,
      switchTargetsCases, switchTargetsDefault, switchTargetsRange, switchTargetsSigned,
-     mapSwitchTargets, switchTargetsToTable, switchTargetsFallThrough,
+     mapSwitchTargets, mapSwitchTargetsA, switchTargetsToTable, switchTargetsFallThrough,
      switchTargetsToList, eqSwitchTargetWith,
 
      SwitchPlan(..),
@@ -136,6 +136,11 @@ mapSwitchTargets :: (Label -> Label) -> SwitchTargets -> SwitchTargets
 mapSwitchTargets f (SwitchTargets signed range mbdef branches)
     = SwitchTargets signed range (fmap f mbdef) (fmap f branches)
 
+-- | Changes all labels mentioned in the SwitchTargets value
+mapSwitchTargetsA :: Applicative m => (Label -> m Label) -> SwitchTargets -> m SwitchTargets
+mapSwitchTargetsA f (SwitchTargets signed range mbdef branches)
+    = SwitchTargets signed range <$> traverse f mbdef <*> traverse f branches
+
 -- | Returns the list of non-default branches of the SwitchTargets value
 switchTargetsCases :: SwitchTargets -> [(Integer, Label)]
 switchTargetsCases (SwitchTargets _ _ _ branches) = M.toList branches

compiler/GHC/Cmm/ThreadSanitizer.hs

@@ -19,6 +19,7 @@ import GHC.Types.Basic
 import GHC.Types.ForeignCall
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
+import GHC.Cmm.Dataflow.Label
 
 import Data.Maybe (fromMaybe)
 
@@ -29,7 +30,7 @@ data Env = Env { platform :: Platform
 annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph
 annotateTSAN platform graph = do
     env <- Env platform <$> getUniqueSupplyM
-    return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph
+    return $ modifyGraph (mapGraphBlocks mapMap (annotateBlock env)) graph
 
 mapBlockList :: (forall e' x'. n e' x' -> Block n e' x')
              -> Block n e x -> Block n e x

compiler/GHC/Cmm/UniqueRenamer.hs

+{-# LANGUAGE LambdaCase, RecordWildCards, MagicHash, UnboxedTuples, PatternSynonyms, ExplicitNamespaces #-}
+module GHC.Cmm.UniqueRenamer
+  ( detRenameCmmGroup
+  , detRenameIPEMap
+  , MonadGetUnique(..)
+
+  -- Careful! Not for general use!
+  , DetUniqFM, emptyDetUFM
+
+  , module GHC.Types.Unique.DSM
+  )
+  where
+
+import GHC.Prelude
+import GHC.Utils.Monad.State.Strict
+import Data.Tuple (swap)
+import GHC.Word
+import GHC.Cmm
+import GHC.Cmm.CLabel
+import GHC.Cmm.Dataflow.Block
+import GHC.Cmm.Dataflow.Graph
+import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Switch
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
+import GHC.Utils.Outputable as Outputable
+import GHC.Types.Id
+import GHC.Types.Unique.DSM
+import GHC.Types.Name hiding (varName)
+import GHC.Types.Var
+import GHC.Types.IPE
+
+{-
+Note [Renaming uniques deterministically]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As mentioned by Note [Object determinism], a key step in producing
+deterministic objects is to rename all existing uniques deterministically.
+
+An important observation is that GHC already produces code in a deterministic
+order, both declarations (say, A_closure always comes before B_closure) and the
+instructions and data within.
+
+We can leverage this /deterministic order/ to
+rename all uniques deterministically, by traversing, specifically, Cmm code
+fresh off of StgToCmm and assigning a new unique from a deterministic supply
+(an incrementing counter) to every non-external unique in the order they are found.
+
+Since the order is deterministic across runs, so will the renamed uniques.
+
+This Cmm renaming pass is guarded by -fobject-determinism because it means the
+compiler must do more work. However, performance profiling has shown the impact
+to be small enough that we should consider enabling -fobject-determinism by
+default instead eventually.
+-}
+
+-- | A mapping from non-deterministic uniques to deterministic uniques, to
+-- rename local symbols with the end goal of producing deterministic object files.
+-- See Note [Renaming uniques deterministically]
+data DetUniqFM = DetUniqFM
+  { mapping :: !(UniqFM Unique Unique)
+  , supply  :: !Word64
+  }
+
+instance Outputable DetUniqFM where
+  ppr DetUniqFM{mapping, supply} =
+    ppr mapping $$
+    text "supply:" Outputable.<> ppr supply
+
+type DetRnM = State DetUniqFM
+
+emptyDetUFM :: DetUniqFM
+emptyDetUFM = DetUniqFM
+  { mapping = emptyUFM
+  -- NB: A lower initial value can get us label `Lsl` which is not parsed
+  -- correctly in older versions of LLVM assembler (llvm-project#80571)
+  -- So we use an `x` s.t. w64ToBase62 x > "R" > "L" > "r" > "l"
+  , supply = 54
+  }
+
+renameDetUniq :: Unique -> DetRnM Unique
+renameDetUniq uq = do
+  m <- gets mapping
+  case lookupUFM m uq of
+    Nothing -> do
+      new_w <- gets supply -- New deterministic unique in this `DetRnM`
+      let --(_tag, _) = unpkUnique uq
+          det_uniq = mkUnique 'Q' new_w
+      modify (\DetUniqFM{mapping, supply} ->
+        -- Update supply and mapping
+        DetUniqFM
+          { mapping = addToUFM mapping uq det_uniq
+          , supply = supply + 1
+          })
+      return det_uniq
+    Just det_uniq ->
+      return det_uniq
+
+-- The most important function here, which does the actual renaming.
+detRenameCLabel :: CLabel -> DetRnM CLabel
+detRenameCLabel = mapInternalNonDetUniques renameDetUniq
+
+-- | We want to rename uniques in Ids, but ONLY internal ones.
+detRenameId :: Id -> DetRnM Id
+detRenameId i
+  | isExternalName (varName i) = return i
+  | otherwise = setIdUnique i <$> renameDetUniq (getUnique i)
+
+-- | Similar to `detRenameId`, but for `Name`.
+detRenameName :: Name -> DetRnM Name
+detRenameName n
+  | isExternalName n = return n
+  | otherwise = setNameUnique n <$> renameDetUniq (getUnique n)
+
+detRenameCmmGroup :: DetUniqFM -> DCmmGroup -> (DetUniqFM, CmmGroup)
+detRenameCmmGroup dufm group = swap (runState (mapM detRenameCmmDecl group) dufm)
+  where
+    detRenameCmmDecl :: DCmmDecl -> DetRnM CmmDecl
+    detRenameCmmDecl (CmmProc h lbl regs g)
+      = do
+        -- Rename the cmm graph first, where things that need to be renamed
+        -- appear in a deterministic order.
+        g' <- detRenameCmmGraph g
+        regs' <- mapM detRenameGlobalReg regs
+        lbl' <- detRenameCLabel lbl
+        -- Rename the info table last! This is necessary for determinism, the
+        -- info table contents not always appear in the same order accross
+        -- runs. As long as all uniques have already been renamed in a deterministic
+        -- order, renaming the info table uniques will only lookup the
+        -- corresponding deterministic ones rather than creating any.
+        h' <- detRenameCmmTop h
+        return (CmmProc h' lbl' regs' g')
+    detRenameCmmDecl (CmmData sec d)
+      = CmmData <$> detRenameSection sec <*> detRenameCmmStatics d
+
+    detRenameCmmTop :: DCmmTopInfo -> DetRnM CmmTopInfo
+    detRenameCmmTop (TopInfo (DWrap i) b)
+      = TopInfo . mapFromList <$> mapM (detRenamePair detRenameLabel detRenameCmmInfoTable) i <*> pure b
+
+    detRenameCmmGraph :: DCmmGraph -> DetRnM CmmGraph
+    detRenameCmmGraph (CmmGraph entry bs)
+      = CmmGraph <$> detRenameLabel entry <*> detRenameGraph bs
+
+    detRenameGraph = \case
+      GNil  -> pure GNil
+      GUnit block -> GUnit <$> detRenameBlock block
+      GMany m1 b m2 -> GMany <$> detRenameMaybeBlock m1 <*> detRenameBody b <*> detRenameMaybeBlock m2
+
+    detRenameBody (DWrap b)
+      = mapFromList <$> mapM (detRenamePair detRenameLabel detRenameBlock) b
+
+    detRenameCmmStatics :: CmmStatics -> DetRnM CmmStatics
+    detRenameCmmStatics
+      (CmmStatics clbl info ccs lits1 lits2)
+        = CmmStatics <$> detRenameCLabel clbl <*> detRenameCmmInfoTable info <*> pure ccs <*> mapM detRenameCmmLit lits1 <*> mapM detRenameCmmLit lits2
+    detRenameCmmStatics
+      (CmmStaticsRaw lbl sts)
+        = CmmStaticsRaw <$> detRenameCLabel lbl <*> mapM detRenameCmmStatic sts
+
+    detRenameCmmInfoTable :: CmmInfoTable -> DetRnM CmmInfoTable
+    detRenameCmmInfoTable
+      CmmInfoTable{cit_lbl, cit_rep, cit_prof, cit_srt, cit_clo}
+        = CmmInfoTable <$> detRenameCLabel cit_lbl <*> pure cit_rep <*> pure cit_prof <*> detRenameMaybe detRenameCLabel cit_srt <*>
+           (case cit_clo of
+              Nothing -> pure Nothing
+              Just (an_id, ccs) -> Just . (,ccs) <$> detRenameId an_id)
+
+    detRenameCmmStatic :: CmmStatic -> DetRnM CmmStatic
+    detRenameCmmStatic = \case
+      CmmStaticLit l -> CmmStaticLit <$> detRenameCmmLit l
+      CmmUninitialised x -> pure $ CmmUninitialised x
+      CmmString x -> pure $ CmmString x
+      CmmFileEmbed f i -> pure $ CmmFileEmbed f i
+
+    detRenameCmmLit :: CmmLit -> DetRnM CmmLit
+    detRenameCmmLit = \case
+      CmmInt i w -> pure $ CmmInt i w
+      CmmFloat r w -> pure $ CmmFloat r w
+      CmmVec lits -> CmmVec <$> mapM detRenameCmmLit lits
+      CmmLabel lbl -> CmmLabel <$> detRenameCLabel lbl
+      CmmLabelOff lbl i -> CmmLabelOff <$> detRenameCLabel lbl <*> pure i
+      CmmLabelDiffOff lbl1 lbl2 i w ->
+        CmmLabelDiffOff <$> detRenameCLabel lbl1 <*> detRenameCLabel lbl2 <*> pure i <*> pure w
+      CmmBlock bid -> CmmBlock <$> detRenameLabel bid
+      CmmHighStackMark -> pure CmmHighStackMark
+
+    detRenameMaybeBlock :: MaybeO n (Block CmmNode a b) -> DetRnM (MaybeO n (Block CmmNode a b))
+    detRenameMaybeBlock (JustO x) = JustO <$> detRenameBlock x
+    detRenameMaybeBlock NothingO = pure NothingO
+
+    detRenameBlock :: Block CmmNode n m -> DetRnM (Block CmmNode n m)
+    detRenameBlock = \case
+      BlockCO n bn -> BlockCO <$> detRenameCmmNode n <*> detRenameBlock bn
+      BlockCC n1 bn n2 -> BlockCC <$> detRenameCmmNode n1 <*> detRenameBlock bn <*> detRenameCmmNode n2
+      BlockOC bn n -> BlockOC <$> detRenameBlock bn <*> detRenameCmmNode n
+      BNil    -> pure BNil
+      BMiddle n -> BMiddle <$> detRenameCmmNode n
+      BCat    b1 b2 -> BCat <$> detRenameBlock b1 <*> detRenameBlock b2
+      BSnoc   bn n -> BSnoc <$> detRenameBlock bn <*> detRenameCmmNode n
+      BCons   n bn -> BCons <$> detRenameCmmNode n <*> detRenameBlock bn
+
+    detRenameCmmNode :: CmmNode n m -> DetRnM (CmmNode n m)
+    detRenameCmmNode = \case
+      CmmEntry l t -> CmmEntry <$> detRenameLabel l <*> detRenameCmmTick t
+      CmmComment fs -> pure $ CmmComment fs
+      CmmTick tickish -> pure $ CmmTick tickish
+      CmmUnwind xs -> CmmUnwind <$> mapM (detRenamePair detRenameGlobalReg (detRenameMaybe detRenameCmmExpr)) xs
+      CmmAssign reg e -> CmmAssign <$> detRenameCmmReg reg <*> detRenameCmmExpr e
+      CmmStore e1 e2 align -> CmmStore <$> detRenameCmmExpr e1 <*> detRenameCmmExpr e2 <*> pure align
+      CmmUnsafeForeignCall ftgt cmmformal cmmactual ->
+        CmmUnsafeForeignCall <$> detRenameForeignTarget ftgt <*> mapM detRenameLocalReg cmmformal <*> mapM detRenameCmmExpr cmmactual
+      CmmBranch l -> CmmBranch <$> detRenameLabel l
+      CmmCondBranch pred t f likely ->
+        CmmCondBranch <$> detRenameCmmExpr pred <*> detRenameLabel t <*> detRenameLabel f <*> pure likely
+      CmmSwitch e sts -> CmmSwitch <$> detRenameCmmExpr e <*> mapSwitchTargetsA detRenameLabel sts
+      CmmCall tgt cont regs args retargs retoff ->
+        CmmCall <$> detRenameCmmExpr tgt <*> detRenameMaybe detRenameLabel cont <*> mapM detRenameGlobalReg regs
+                <*> pure args <*> pure retargs <*> pure retoff
+      CmmForeignCall tgt res args succ retargs retoff intrbl ->
+        CmmForeignCall <$> detRenameForeignTarget tgt <*> mapM detRenameLocalReg res <*> mapM detRenameCmmExpr args
+                       <*> detRenameLabel succ <*> pure retargs <*> pure retoff <*> pure intrbl
+
+    detRenameCmmExpr :: CmmExpr -> DetRnM CmmExpr
+    detRenameCmmExpr = \case
+      CmmLit l -> CmmLit <$> detRenameCmmLit l
+      CmmLoad e t a -> CmmLoad <$> detRenameCmmExpr e <*> pure t <*> pure a
+      CmmReg r -> CmmReg <$> detRenameCmmReg r
+      CmmMachOp mop es -> CmmMachOp mop <$> mapM detRenameCmmExpr es
+      CmmStackSlot a i -> CmmStackSlot <$> detRenameArea a <*> pure i
+      CmmRegOff r i -> CmmRegOff <$> detRenameCmmReg r <*> pure i
+
+    detRenameForeignTarget :: ForeignTarget -> DetRnM ForeignTarget
+    detRenameForeignTarget = \case
+        ForeignTarget e fc -> ForeignTarget <$> detRenameCmmExpr e <*> pure fc
+        PrimTarget cmop -> pure $ PrimTarget cmop
+
+    detRenameArea :: Area -> DetRnM Area
+    detRenameArea Old = pure Old
+    detRenameArea (Young l) = Young <$> detRenameLabel l
+
+    detRenameLabel :: Label -> DetRnM Label
+    detRenameLabel lbl
+      = mkHooplLabel . getKey <$> renameDetUniq (getUnique lbl)
+
+    detRenameSection :: Section -> DetRnM Section
+    detRenameSection (Section ty lbl)
+      = Section ty <$> detRenameCLabel lbl
+
+    detRenameCmmReg :: CmmReg -> DetRnM CmmReg
+    detRenameCmmReg = \case
+      CmmLocal l -> CmmLocal <$> detRenameLocalReg l
+      CmmGlobal x -> pure $ CmmGlobal x
+
+    detRenameLocalReg :: LocalReg -> DetRnM LocalReg
+    detRenameLocalReg (LocalReg uq t)
+      = LocalReg <$> renameDetUniq uq <*> pure t
+
+    detRenameGlobalReg :: GlobalReg -> DetRnM GlobalReg
+    detRenameGlobalReg = pure -- Nothing needs to be renamed here
+
+    -- todo: We may have to change this to get deterministic objects with ticks.
+    detRenameCmmTick :: CmmTickScope -> DetRnM CmmTickScope
+    detRenameCmmTick = pure
+
+    detRenameMaybe _ Nothing = pure Nothing
+    detRenameMaybe f (Just x) = Just <$> f x
+
+    detRenamePair f g (a, b) = (,) <$> f a <*> g b
+
+detRenameIPEMap :: DetUniqFM -> InfoTableProvMap -> (DetUniqFM, InfoTableProvMap)
+detRenameIPEMap dufm InfoTableProvMap{ provDC, provClosure, provInfoTables } =
+    (dufm2, InfoTableProvMap { provDC, provClosure = cm, provInfoTables })
+  where
+    (cm, dufm2) = runState (detRenameClosureMap provClosure) dufm
+
+    detRenameClosureMap :: ClosureMap -> DetRnM ClosureMap
+    detRenameClosureMap m =
+      -- `eltsUDFM` preserves the deterministic order, but it doesn't matter
+      -- since we will rename all uniques deterministically, thus the
+      -- reconstructed map will necessarily be deterministic too.
+      listToUDFM <$> mapM (\(n,r) -> do
+        n' <- detRenameName n
+        return (n', (n', r))
+        ) (eltsUDFM m)

compiler/GHC/CmmToAsm/Reg/Liveness.hs

@@ -14,7 +14,7 @@
 module GHC.CmmToAsm.Reg.Liveness (
         RegSet,
         RegMap, emptyRegMap,
-        BlockMap, mapEmpty,
+        BlockMap,
         LiveCmmDecl,
         InstrSR   (..),
         LiveInstr (..),
@@ -260,7 +260,7 @@ instance OutputableP Platform LiveInfo where
         =  (pdoc env mb_static)
         $$ text "# entryIds         = " <> ppr entryIds
         $$ text "# liveVRegsOnEntry = " <> ppr liveVRegsOnEntry
-        $$ text "# liveSlotsOnEntry = " <> text (show liveSlotsOnEntry)
+        $$ text "# liveSlotsOnEntry = " <> ppr liveSlotsOnEntry
 
 
 

compiler/GHC/Driver/Config/StgToCmm.hs

@@ -53,6 +53,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
   , stgToCmmExtDynRefs    = gopt Opt_ExternalDynamicRefs   dflags
   , stgToCmmDoBoundsCheck = gopt Opt_DoBoundsChecking      dflags
   , stgToCmmDoTagCheck    = gopt Opt_DoTagInferenceChecks  dflags
+  , stgToCmmObjectDeterminism = gopt Opt_ObjectDeterminism dflags
 
   -- backend flags:
 

compiler/GHC/Driver/Flags.hs

@@ -822,6 +822,9 @@ data GeneralFlag
    -- Error message suppression
    | Opt_ShowErrorContext
 
+   -- Object code determinism
+   | Opt_ObjectDeterminism
+
    -- temporary flags
    | Opt_AutoLinkPackages
    | Opt_ImplicitImportQualified
@@ -932,6 +935,7 @@ codeGenFlags = EnumSet.fromList
    , Opt_ExposeAllUnfoldings
    , Opt_ExposeOverloadedUnfoldings
    , Opt_NoTypeableBinds
+   , Opt_ObjectDeterminism
    , Opt_Haddock
 
      -- Flags that affect catching of runtime errors

compiler/GHC/Driver/GenerateCgIPEStub.hs

@@ -20,7 +20,7 @@ import GHC.Driver.Env.Types (HscEnv)
 import GHC.Driver.Flags (GeneralFlag (..), DumpFlag(Opt_D_ipe_stats))
 import GHC.Driver.DynFlags (gopt, targetPlatform)
 import GHC.Driver.Config.StgToCmm
-import GHC.Driver.Config.Cmm
+import GHC.Driver.Config.Cmm ( initCmmConfig )
 import GHC.Prelude
 import GHC.Runtime.Heap.Layout (isStackRep)
 import GHC.Settings (platformTablesNextToCode)
@@ -37,6 +37,7 @@ import GHC.Unit.Module (moduleNameString)
 import qualified GHC.Utils.Logger as Logger
 import GHC.Utils.Outputable (ppr)
 import GHC.Types.Unique.DSM
+import qualified Control.Monad.Trans.State.Strict as T
 
 {-
 Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
@@ -195,6 +196,7 @@ generateCgIPEStub
   :: HscEnv
   -> Module
   -> InfoTableProvMap
+  -- ^ If the CmmInfoTables map refer Cmm symbols which were deterministically renamed, the info table provenance map must also be accordingly renamed.
   -> ( NonCaffySet
      , ModuleLFInfos
      , Map CmmInfoTable (Maybe IpeSourceLocation)
@@ -209,11 +211,22 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW
       cmm_cfg  = initCmmConfig dflags
   cgState <- liftIO initC
 
+  -- NB: For determinism, don't use DetUniqFM to rename the IPE Cmm because
+  -- detRenameCmm isn't idempotent and this Cmm references symbols in the rest
+  -- of the code!  Instead, make sure all labels generated for IPE related code
+  -- sources uniques from the DUniqSupply gotten from CgStream (see its use in
+  -- initInfoTableProv/emitIpeBufferListNode).
+  dus <- liftEff $ UDSMT $ T.get
+
   -- Yield Cmm for Info Table Provenance Entries (IPEs)
   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')
+      (((mIpeStub, dus'), ipeCmmGroup), _) =
+          runC (initStgToCmmConfig dflags this_mod) fstate cgState $
+            getCmm (initInfoTableProv initStats (Map.keys infoTablesWithTickishes) denv' dus)
+
+  liftEff $ UDSMT $ T.put dus'
 
-  (_, ipeCmmGroupSRTs) <- liftEff $ withDUS $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup
+  (_, ipeCmmGroupSRTs) <- liftEff $ withDUS $ cmmPipeline logger cmm_cfg (emptySRT this_mod) (removeDeterm ipeCmmGroup)
   Stream.yield ipeCmmGroupSRTs
 
   ipeStub <-

compiler/GHC/Driver/Main.hs

@@ -215,6 +215,7 @@ import GHC.Cmm.Info.Build
 import GHC.Cmm.Pipeline
 import GHC.Cmm.Info
 import GHC.Cmm.Parser
+import GHC.Cmm.UniqueRenamer
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -299,7 +300,6 @@ import GHC.Stg.InferTags.TagSig (seqTagSig)
 import GHC.StgToCmm.Utils (IPEStats)
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
-import GHC.Types.Unique.DSM
 import GHC.Cmm.Config (CmmConfig)
 import Data.Bifunctor
 
@@ -2121,12 +2121,14 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
         mod_name = mkModuleName $ "Cmm$" ++ original_filename
         cmm_mod = mkHomeModule home_unit mod_name
         cmmpConfig = initCmmParserConfig dflags
-    (cmm, ipe_ents) <- ioMsgMaybe
+    (dcmm, ipe_ents) <- ioMsgMaybe
                $ do
                   (warns,errs,cmm) <- withTiming logger (text "ParseCmm"<+>brackets (text filename)) (\_ -> ())
                                        $ parseCmmFile cmmpConfig cmm_mod home_unit filename
                   let msgs = warns `unionMessages` errs
                   return (GhcPsMessage <$> msgs, cmm)
+    -- Probably need to rename cmm here
+    let cmm = removeDeterm dcmm
     liftIO $ do
         putDumpFileMaybe logger Opt_D_dump_cmm_verbose_by_proc "Parsed Cmm" FormatCMM (pdoc platform cmm)
 
@@ -2211,11 +2213,11 @@ doCodeGen hsc_env this_mod denv data_tycons
     putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG
         (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs)
 
-    let stg_to_cmm dflags mod = case stgToCmmHook hooks of
-                        Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod)
-                        Just h  -> h                             (initStgToCmmConfig dflags mod)
+    let stg_to_cmm dflags mod a b c d e = case stgToCmmHook hooks of
+          Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) a b c d e
+          Just h  -> (,emptyDetUFM) <$> h          (initStgToCmmConfig dflags mod) a b c d e
 
-    let cmm_stream :: CgStream CmmGroup ModuleLFInfos
+    let cmm_stream :: CgStream CmmGroup (ModuleLFInfos, DetUniqFM)
         -- See Note [Forcing of stg_binds]
         cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-}
             stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info
@@ -2237,11 +2239,21 @@ doCodeGen hsc_env this_mod denv data_tycons
 
         pipeline_stream :: CgStream CmmGroupSRTs CmmCgInfos
         pipeline_stream = do
-          ((mod_srt_info, ipes, ipe_stats), lf_infos) <-
+          ((mod_srt_info, ipes, ipe_stats), (lf_infos, detRnEnv)) <-
             {-# SCC "cmmPipeline" #-}
             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)
+
+              -- denv::InfoTableProvMap refers to symbols that no longer exist
+              -- if -fobject-determinism is on, since it was created before the
+              -- Cmm was renamed. Update all the symbols by renaming them with
+              -- the renaming map in that case.
+              (_drn, rn_denv)
+                | gopt Opt_ObjectDeterminism dflags = detRenameIPEMap detRnEnv denv
+                | otherwise = (detRnEnv, denv)
+
+          cmmCgInfos <- generateCgIPEStub hsc_env this_mod rn_denv (nonCaffySet, lf_infos, ipes, ipe_stats)
           return cmmCgInfos
 
         pipeline_action

compiler/GHC/Driver/Session.hs

@@ -1290,6 +1290,8 @@ dynamic_flags_deps = [
         (NoArg (unSetGeneralFlag Opt_KeepOFiles))
 
         ------- Miscellaneous ----------------------------------------------
+  , make_ord_flag defGhcFlag "fobject-determinism"
+        (NoArg (setGeneralFlag Opt_ObjectDeterminism))
   , make_ord_flag defGhcFlag "no-auto-link-packages"
         (NoArg (unSetGeneralFlag Opt_AutoLinkPackages))
   , make_ord_flag defGhcFlag "no-hs-main"

compiler/GHC/Stg/Debug.hs

@@ -11,6 +11,7 @@ import GHC.Prelude
 
 import GHC.Stg.Syntax
 
+import GHC.Types.Unique.DFM
 import GHC.Types.Id
 import GHC.Types.Tickish
 import GHC.Core.DataCon
@@ -23,7 +24,6 @@ import Control.Monad (when)
 import Control.Monad.Trans.Reader
 import GHC.Utils.Monad.State.Strict
 import Control.Monad.Trans.Class
-import GHC.Types.Unique.Map
 import GHC.Types.SrcLoc
 import Control.Applicative
 import qualified Data.List.NonEmpty as NE
@@ -153,7 +153,7 @@ recordStgIdPosition id best_span ss = do
     --Useful for debugging why a certain Id gets given a certain span
     --pprTraceM "recordStgIdPosition" (ppr id $$ ppr cc $$ ppr best_span $$ ppr ss)
     let mbspan = (\(SpanWithLabel rss d) -> (rss, d)) <$> (best_span <|> cc <|> ss)
-    lift $ modify (\env -> env { provClosure = addToUniqMap (provClosure env) (idName id) (idType id, mbspan) })
+    lift $ modify (\env -> env { provClosure = addToUDFM (provClosure env) (idName id) (idName id, (idType id, mbspan)) })
 
 numberDataCon :: DataCon -> [StgTickish] -> M ConstructorNumber
 -- Unboxed tuples and sums do not allocate so they
@@ -166,13 +166,13 @@ numberDataCon dc ts = do
     env <- lift get
     mcc <- asks rSpan
     let !mbest_span = (\(SpanWithLabel rss l) -> (rss, l)) <$> (selectTick ts <|> mcc)
-    let !dcMap' = alterUniqMap (maybe (Just ((0, mbest_span) :| [] ))
-                        (\xs@((k, _):|_) -> Just $! ((k + 1, mbest_span) `NE.cons` xs))) (provDC env) dc
+    let !dcMap' = alterUDFM (maybe (Just (dc, (0, mbest_span) :| [] ))
+                        (\(_dc, xs@((k, _):|_)) -> Just $! (dc, (k + 1, mbest_span) `NE.cons` xs))) (provDC env) dc
     lift $ put (env { provDC = dcMap' })
-    let r = lookupUniqMap dcMap' dc
+    let r = lookupUDFM dcMap' dc
     return $ case r of
       Nothing -> NoNumber
-      Just res -> Numbered (fst (NE.head res))
+      Just (_, res) -> Numbered (fst (NE.head res))
 
 selectTick :: [StgTickish] -> Maybe SpanWithLabel
 selectTick [] = Nothing

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
@@ -43,6 +44,7 @@ import GHC.Types.Id.Info
 import GHC.Types.RepType
 import GHC.Types.Basic
 import GHC.Types.Var.Set ( isEmptyDVarSet )
+import GHC.Types.Unique.DFM
 import GHC.Types.Unique.FM
 import GHC.Types.Name.Env
 
@@ -60,7 +62,6 @@ import GHC.Utils.TmpFs
 
 import GHC.Data.Stream
 import GHC.Data.OrdList
-import GHC.Types.Unique.Map
 
 import Control.Monad (when,void, forM_)
 import GHC.Utils.Misc
@@ -77,29 +78,43 @@ codeGen :: Logger
         -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.
         -> [CgStgTopBinding]           -- Bindings to convert
         -> HpcInfo
-        -> CgStream CmmGroup ModuleLFInfos -- See Note [Deterministic Uniques in the CG] on why UniqDSMT
+        -> CgStream CmmGroup (ModuleLFInfos, DetUniqFM) -- See Note [Deterministic Uniques in the CG] on CgStream
                                        -- Output as a stream, so codegen can
                                        -- be interleaved with output
 
-codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
+codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons
         cost_centre_info stg_binds hpc_info
   = do  {     -- cg: run the code generator, and yield the resulting CmmGroup
               -- Using an IORef to store the state is a bit crude, but otherwise
               -- 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 -> CgStream 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)
+
+                         rnm0 <- readIORef uniqRnRef
+
+                         let
+                           ((a, cmm), st') = runC cfg fstate st (getCmm fcode)
+                           (rnm1, cmm_renamed) =
+                             -- Enable deterministic object code generation by
+                             -- renaming uniques deterministically.
+                             -- See Note [Object determinism]
+                             if stgToCmmObjectDeterminism cfg
+                                then detRenameCmmGroup rnm0 cmm -- The yielded cmm will already be renamed.
+                                else (rnm0, removeDeterm cmm)
 
                          -- 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
 
@@ -122,7 +137,7 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
 
         -- Emit special info tables for everything used in this module
         -- This will only do something if  `-fdistinct-info-tables` is turned on.
-        ; mapM_ (\(dc, ns) -> forM_ ns $ \(k, _ss) -> cg (cgDataCon (UsageSite (stgToCmmThisModule cfg) k) dc)) (nonDetEltsUFM denv)
+        ; mapM_ (\(dc, ns) -> forM_ ns $ \(k, _ss) -> cg (cgDataCon (UsageSite (stgToCmmThisModule cfg) k) dc)) (eltsUDFM denv)
 
         ; final_state <- liftIO (readIORef cgref)
         ; let cg_id_infos = cgs_binds final_state
@@ -140,9 +155,62 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
                 | otherwise
                 = mkNameEnv (Prelude.map extractInfo (nonDetEltsUFM cg_id_infos))
 
-        ; return generatedInfo
+        ; rn_mapping <- liftIO (readIORef uniqRnRef)
+        ; liftIO $ debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping)
+
+        ; return (generatedInfo, rn_mapping)
         }
 
+{-
+Note [Object determinism]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Object determinism means that GHC, for the same exact input, produces,
+deterministically, byte-for-byte identical objects (.o files, executables,
+libraries...) on separate multi-threaded runs.
+
+Deterministic objects are critical, for instance, for reproducible software
+packaging and distribution, or build systems with content-sensitive
+recompilation avoidance.
+
+The main cause of non-determinism in objects comes from the non-deterministic
+uniques leaking into the generated code. Apart from uniques previously affecting
+determinism both directly by showing up in symbol labels and indirectly, e.g. in
+the CLabel Ord instance, GHC already did a lot deterministically (modulo bugs)
+by the time we set out to achieve full object determinism:
+
+* The Simplifier is deterministic in the optimisations it applies (c.f. #25170)
+
+* Interface files are deterministic (which depends on the previous bullet)
+
+* The Cmm/NCG pipeline processes sections in a deterministic order, so the final
+  object sections, closures, data, etc., are already always outputted in the
+  same order for the same module.
+
+Beyond fixing small bugs in the above bullets and other smaller non-determinism
+leaks like the Ord instance of CLabels, we must ensure that/do the following to
+make GHC produce fully deterministic objects:
+
+* In STG -> Cmm, deterministically /rename/ all non-external uniques in the Cmm
+  chunk, deterministically, before yielding. See Note [Renaming uniques deterministically]
+  in GHC.Cmm.UniqueRenamer. This pass is necessary for object determinism but
+  is currently guarded by -fobject-determinism.
+
+* Multiple Cmm passes work with non-deterministic @LabelMap@s -- that doesn't
+  change since they are both important for performance and do not affect the
+  determinism of the end result. As after the renaming pass the uniques are all
+  produced deterministically, the orderings observable by the map are also going
+  to be deterministic. In the brief period before a CmmGroup has been renamed,
+  a list instead of LabelMap is used to preserve the ordering.
+  See Note [DCmmGroup vs CmmGroup or: Deterministic Info Tables] in GHC.Cmm.
+
+* In the code generation pipeline from Cmm onwards, when new uniques need to be
+  created for a given pass, use @UniqDSM@ instead of the previously used @UniqSM@.
+  @UniqDSM@ supplies uniques iteratively, guaranteeing uniques produced by the
+  backend are deterministic accross runs.
+  See Note [Deterministic Uniques in the CG] in GHC.Types.Unique.DSM.
+-}
+
+
 ---------------------------------------------------------------
 --      Top-level bindings
 ---------------------------------------------------------------

compiler/GHC/StgToCmm/CgUtils.hs

@@ -29,6 +29,7 @@ import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
 import GHC.Utils.Panic
+import GHC.Cmm.Dataflow.Label
 
 import GHC.Data.Stream (Stream)
 import GHC.Types.Unique.DSM (UniqDSMT)
@@ -150,7 +151,7 @@ fixStgRegisters :: Platform -> RawCmmDecl -> RawCmmDecl
 fixStgRegisters _ top@(CmmData _ _) = top
 
 fixStgRegisters platform (CmmProc info lbl live graph) =
-  let graph' = modifyGraph (mapGraphBlocks (fixStgRegBlock platform)) graph
+  let graph' = modifyGraph (mapGraphBlocks mapMap (fixStgRegBlock platform)) graph
   in CmmProc info lbl live graph'
 
 fixStgRegBlock :: Platform -> Block CmmNode e x -> Block CmmNode e x