Compare revisions

ada04031 · ada04031 · ada04031 · ada04031 · ada04031 · ada04031
--- a/compiler/GHC/Cmm/Graph.hs
+++ b/compiler/GHC/Cmm/Graph.hs
-{-# LANGUAGE BangPatterns, GADTs #-}
+{-# LANGUAGE GADTs #-}

 module GHC.Cmm.Graph
  ( CmmAGraph, CmmAGraphScoped, CgStmt(..)
@@ -37,7 +37,7 @@ import GHC.Data.FastString
 import GHC.Types.ForeignCall
 import GHC.Data.OrdList
 import GHC.Runtime.Heap.Layout (ByteOff)
-import GHC.Types.Unique.Supply
+import GHC.Types.Unique.DSM
 import GHC.Utils.Constants (debugIsOn)
 import GHC.Utils.Panic

@@ -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 -> UniqSM CmmGraph
+lgraphOfAGraph :: CmmAGraphScoped -> UniqDSM DCmmGraph
 lgraphOfAGraph g = do
-  u <- getUniqueM
+  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
@@ -208,7 +208,7 @@ mkJump profile conv e actuals updfr_off =

 -- | A jump where the caller says what the live GlobalRegs are.  Used
 -- for low-level hand-written Cmm.
-mkRawJump       :: Profile -> CmmExpr -> UpdFrameOffset -> [GlobalReg]
+mkRawJump       :: Profile -> CmmExpr -> UpdFrameOffset -> [GlobalRegUse]
                -> CmmAGraph
 mkRawJump profile e updfr_off vols =
  lastWithArgs profile Jump Old NativeNodeCall [] updfr_off $
@@ -297,7 +297,7 @@ stackStubExpr w = CmmLit (CmmInt 0 w)
 copyInOflow  :: Profile -> Convention -> Area
             -> [CmmFormal]
             -> [CmmFormal]
-             -> (Int, [GlobalReg], CmmAGraph)
+             -> (Int, [GlobalRegUse], CmmAGraph)

 copyInOflow profile conv area formals extra_stk
  = (offset, gregs, catAGraphs $ map mkMiddle nodes)
@@ -308,9 +308,9 @@ copyInOflow profile conv area formals extra_stk
 copyIn :: Profile -> Convention -> Area
       -> [CmmFormal]
       -> [CmmFormal]
-       -> (ByteOff, [GlobalReg], [CmmNode O O])
+       -> (ByteOff, [GlobalRegUse], [CmmNode O O])
 copyIn profile conv area formals extra_stk
-  = (stk_size, [r | (_, RegisterParam r) <- args], map ci (stk_args ++ args))
+  = (stk_size, [GlobalRegUse r (localRegType lr)| (lr, RegisterParam r) <- args], map ci (stk_args ++ args))
  where
    platform = profilePlatform profile

@@ -365,7 +365,7 @@ data Transfer = Call | JumpRet | Jump | Ret deriving Eq
 copyOutOflow :: Profile -> Convention -> Transfer -> Area -> [CmmExpr]
             -> UpdFrameOffset
             -> [CmmExpr] -- extra stack args
-             -> (Int, [GlobalReg], CmmAGraph)
+             -> (Int, [GlobalRegUse], CmmAGraph)

 -- Generate code to move the actual parameters into the locations
 -- required by the calling convention.  This includes a store for the
@@ -383,8 +383,8 @@ copyOutOflow profile conv transfer area actuals updfr_off extra_stack_stuff
    (regs, graph) = foldr co ([], mkNop) (setRA ++ args ++ stack_params)

    co :: (CmmExpr, ParamLocation)
-       -> ([GlobalReg], CmmAGraph)
-       -> ([GlobalReg], CmmAGraph)
+       -> ([GlobalRegUse], CmmAGraph)
+       -> ([GlobalRegUse], CmmAGraph)
    co (v, RegisterParam r@(VanillaReg {})) (rs, ms) =
        let width = cmmExprWidth platform v
            value
@@ -393,12 +393,14 @@ copyOutOflow profile conv transfer area actuals updfr_off extra_stack_stuff
                | width < wordWidth platform =
                    CmmMachOp (MO_XX_Conv width (wordWidth platform)) [v]
                | otherwise = panic "Parameter width greater than word width"
+            ru = GlobalRegUse r (cmmExprType platform value)

-        in (r:rs, mkAssign (CmmGlobal $ GlobalRegUse r (cmmExprType platform value)) value <*> ms)
+        in (ru:rs, mkAssign (CmmGlobal ru) value <*> ms)

    -- Non VanillaRegs
    co (v, RegisterParam r) (rs, ms) =
-        (r:rs, mkAssign (CmmGlobal $ GlobalRegUse r (cmmExprType platform v)) v <*> ms)
+      let ru = GlobalRegUse r (cmmExprType platform v)
+      in (ru:rs, mkAssign (CmmGlobal ru) v <*> ms)

    co (v, StackParam off)  (rs, ms)
      = (rs, mkStore (CmmStackSlot area off) (value v) <*> ms)
@@ -461,13 +463,13 @@ copyOutOflow profile conv transfer area actuals updfr_off extra_stack_stuff


 mkCallEntry :: Profile -> Convention -> [CmmFormal] -> [CmmFormal]
-            -> (Int, [GlobalReg], CmmAGraph)
+            -> (Int, [GlobalRegUse], CmmAGraph)
 mkCallEntry profile conv formals extra_stk
  = copyInOflow profile conv Old formals extra_stk

 lastWithArgs :: Profile -> Transfer -> Area -> Convention -> [CmmExpr]
             -> UpdFrameOffset
-             -> (ByteOff -> [GlobalReg] -> CmmAGraph)
+             -> (ByteOff -> [GlobalRegUse] -> CmmAGraph)
             -> CmmAGraph
 lastWithArgs profile transfer area conv actuals updfr_off last =
  lastWithArgsAndExtraStack profile transfer area conv actuals
@@ -476,7 +478,7 @@ lastWithArgs profile transfer area conv actuals updfr_off last =
 lastWithArgsAndExtraStack :: Profile
             -> Transfer -> Area -> Convention -> [CmmExpr]
             -> UpdFrameOffset -> [CmmExpr]
-             -> (ByteOff -> [GlobalReg] -> CmmAGraph)
+             -> (ByteOff -> [GlobalRegUse] -> CmmAGraph)
             -> CmmAGraph
 lastWithArgsAndExtraStack profile transfer area conv actuals updfr_off
                          extra_stack last =
@@ -490,7 +492,7 @@ noExtraStack :: [CmmExpr]
 noExtraStack = []

 toCall :: CmmExpr -> Maybe BlockId -> UpdFrameOffset -> ByteOff
-       -> ByteOff -> [GlobalReg]
+       -> ByteOff -> [GlobalRegUse]
       -> CmmAGraph
 toCall e cont updfr_off res_space arg_space regs =
  mkLast $ CmmCall e cont regs arg_space res_space updfr_off
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -36,22 +36,22 @@ import GHC.Prelude
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
+import GHC.StgToCmm.CgUtils (CgStream)
 import GHC.Runtime.Heap.Layout
 import GHC.Data.Bitmap
-import GHC.Data.Stream (Stream)
 import qualified GHC.Data.Stream as Stream
-import GHC.Cmm.Dataflow.Collections
+import GHC.Cmm.Dataflow.Label

 import GHC.Platform
 import GHC.Platform.Profile
 import GHC.Data.Maybe
 import GHC.Utils.Error (withTimingSilent)
 import GHC.Utils.Panic
-import GHC.Types.Unique.Supply
 import GHC.Utils.Logger
 import GHC.Utils.Monad
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
+import GHC.Types.Unique.DSM

 import Data.ByteString (ByteString)

@@ -64,19 +64,15 @@ mkEmptyContInfoTable info_lbl
                 , cit_srt  = Nothing
                 , cit_clo  = Nothing }

-cmmToRawCmm :: Logger -> Profile -> Stream IO CmmGroupSRTs a
-            -> IO (Stream IO RawCmmGroup a)
+cmmToRawCmm :: Logger -> Profile -> CgStream CmmGroupSRTs a
+            -> IO (CgStream RawCmmGroup a)
 cmmToRawCmm logger profile cmms
-  = do {
-       ; let do_one :: [CmmDeclSRTs] -> IO [RawCmmDecl]
-             do_one cmm = do
-               uniqs <- mkSplitUniqSupply 'i'
+  = do { let do_one :: [CmmDeclSRTs] -> UniqDSMT IO [RawCmmDecl]
+             do_one cmm = setTagUDSMT 'i' $ do
               -- NB. strictness fixes a space leak.  DO NOT REMOVE.
-               withTimingSilent logger (text "Cmm -> Raw Cmm") (\x -> seqList x ())
-                  -- TODO: It might be better to make `mkInfoTable` run in
-                  -- IO as well so we don't have to pass around
-                  -- a UniqSupply (see #16843)
-                 (return $ initUs_ uniqs $ concatMapM (mkInfoTable profile) cmm)
+               withTimingSilent logger (text "Cmm -> Raw Cmm") (\x -> seqList x ()) $ do
+                 liftUniqDSM $
+                   concatMapM (mkInfoTable profile) cmm
       ; return (Stream.mapM do_one cmms)
       }

@@ -114,7 +110,7 @@ cmmToRawCmm logger profile cmms
 --
 --  * The SRT slot is only there if there is SRT info to record

-mkInfoTable :: Profile -> CmmDeclSRTs -> UniqSM [RawCmmDecl]
+mkInfoTable :: Profile -> CmmDeclSRTs -> UniqDSM [RawCmmDecl]
 mkInfoTable _ (CmmData sec dat) = return [CmmData sec dat]

 mkInfoTable profile proc@(CmmProc infos entry_lbl live blocks)
@@ -177,7 +173,7 @@ type InfoTableContents = ( [CmmLit]          -- The standard part
 mkInfoTableContents :: Profile
                    -> CmmInfoTable
                    -> Maybe Int               -- Override default RTS type tag?
-                    -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls
+                    -> UniqDSM ([RawCmmDecl],             -- Auxiliary top decls
                               InfoTableContents)       -- Info tbl + extra bits

 mkInfoTableContents profile
@@ -218,10 +214,10 @@ mkInfoTableContents profile
  where
    platform = profilePlatform profile
    mk_pieces :: ClosureTypeInfo -> [CmmLit]
-              -> UniqSM ( Maybe CmmLit  -- Override the SRT field with this
-                        , Maybe CmmLit  -- Override the layout field with this
-                        , [CmmLit]           -- "Extra bits" for info table
-                        , [RawCmmDecl])      -- Auxiliary data decls
+              -> UniqDSM ( Maybe CmmLit  -- Override the SRT field with this
+                         , Maybe CmmLit  -- Override the layout field with this
+                         , [CmmLit]           -- "Extra bits" for info table
+                         , [RawCmmDecl])      -- Auxiliary data decls
    mk_pieces (Constr con_tag con_descr) _no_srt    -- A data constructor
      = do { (descr_lit, decl) <- newStringLit con_descr
           ; return ( Just (CmmInt (fromIntegral con_tag)
@@ -338,14 +334,14 @@ makeRelativeRefTo platform info_lbl lit
 -- The head of the stack layout is the top of the stack and
 -- the least-significant bit.

-mkLivenessBits :: Platform -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
+mkLivenessBits :: Platform -> Liveness -> UniqDSM (CmmLit, [RawCmmDecl])
              -- ^ Returns:
              --   1. The bitmap (literal value or label)
              --   2. Large bitmap CmmData if needed

 mkLivenessBits platform liveness
  | n_bits > mAX_SMALL_BITMAP_SIZE platform -- does not fit in one word
-  = do { uniq <- getUniqueM
+  = do { uniq <- getUniqueDSM
       ; let bitmap_lbl = mkBitmapLabel uniq
       ; return (CmmLabel bitmap_lbl,
                 [mkRODataLits bitmap_lbl lits]) }
@@ -412,16 +408,16 @@ mkStdInfoTable profile (type_descr, closure_descr) cl_type srt layout_lit
 --
 -------------------------------------------------------------------------

-mkProfLits :: Platform -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
+mkProfLits :: Platform -> ProfilingInfo -> UniqDSM ((CmmLit,CmmLit), [RawCmmDecl])
 mkProfLits platform NoProfilingInfo = return ((zeroCLit platform, zeroCLit platform), [])
 mkProfLits _ (ProfilingInfo td cd)
  = do { (td_lit, td_decl) <- newStringLit td
       ; (cd_lit, cd_decl) <- newStringLit cd
       ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }

-newStringLit :: ByteString -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
+newStringLit :: ByteString -> UniqDSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
 newStringLit bytes
-  = do { uniq <- getUniqueM
+  = do { uniq <- getUniqueDSM
       ; return (mkByteStringCLit (mkStringLitLabel uniq) bytes) }


@@ -449,7 +445,7 @@ wordAligned platform align_check e
 -- | Takes a closure pointer and returns the info table pointer
 closureInfoPtr :: Platform -> DoAlignSanitisation -> CmmExpr -> CmmExpr
 closureInfoPtr platform align_check e =
-    cmmLoadBWord platform (wordAligned platform align_check e)
+    CmmMachOp (MO_RelaxedRead (wordWidth platform)) [wordAligned platform align_check e]

 -- | Takes an info pointer (the first word of a closure) and returns its entry
 -- code

--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
-{-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
-    GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections,
-    ScopedTypeVariables, OverloadedStrings, LambdaCase, EmptyCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE GADTs, RecordWildCards,
+    NondecreasingIndentation,
+    OverloadedStrings, LambdaCase #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-}


@@ -27,7 +23,6 @@ import GHC.Cmm.Config
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
 import GHC.Unit.Module
 import GHC.Data.Graph.Directed
@@ -38,7 +33,6 @@ import GHC.Data.Maybe
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Runtime.Heap.Layout
-import GHC.Types.Unique.Supply
 import GHC.Types.CostCentre
 import GHC.StgToCmm.Heap

@@ -52,6 +46,7 @@ import Control.Monad.Trans.Class
 import Data.List (unzip4)

 import GHC.Types.Name.Set
+import GHC.Types.Unique.DSM

 {- Note [SRTs]
   ~~~~~~~~~~~
@@ -883,18 +878,20 @@ 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
-  us <- mkSplitUniqSupply 'u'
+doSRTs cfg moduleSRTInfo dus0 procs data_ = do

-  let profile = cmmProfile cfg
+  let origtag = getTagDUniqSupply dus0
+      profile = cmmProfile cfg
+      dus1    = newTagDUniqSupply 'u' dus0

  -- Ignore the original grouping of decls, and combine all the
  -- CAFEnvs into a single CAFEnv.
-  let static_data_env :: DataCAFEnv
+      static_data_env :: DataCAFEnv
      static_data_env =
        Map.fromList $
        flip map data_ $
@@ -941,8 +938,8 @@ doSRTs cfg moduleSRTInfo procs data_ = do
          , CafInfo                -- Whether the group has CAF references
          ) ]

-      (result, moduleSRTInfo') =
-        initUs_ us $
+      ((result, moduleSRTInfo'), dus2) =
+        runUniqueDSM dus1 $
        flip runStateT moduleSRTInfo $ do
          nonCAFs <- mapM (doSCC cfg staticFuns static_data_env) sccs
          cAFs <- forM cafsWithSRTs $ \(l, cafLbl, cafs) ->
@@ -981,8 +978,8 @@ doSRTs cfg moduleSRTInfo procs data_ = do
                          srtMap
                    CmmProc void _ _ _ -> case void of)
               (moduleSRTMap moduleSRTInfo') data_
-
-  return (moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, srt_decls ++ decls')
+      dus3 = newTagDUniqSupply origtag dus2 -- restore original tag
+  return (moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, dus3, srt_decls ++ decls')


 -- | Build the SRT for a strongly-connected component of blocks.
@@ -991,7 +988,7 @@ doSCC
  -> LabelMap CLabel -- ^ which blocks are static function entry points
  -> DataCAFEnv      -- ^ static data
  -> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-  -> StateT ModuleSRTInfo UniqSM
+  -> StateT ModuleSRTInfo UniqDSM
        ( [CmmDeclSRTs]          -- generated SRTs
        , [(Label, CLabel)]      -- SRT fields for info tables
        , [(Label, [SRTEntry])]  -- SRTs to attach to static functions
@@ -1046,7 +1043,7 @@ oneSRT
  -> Bool                       -- ^ True <=> this SRT is for a CAF
  -> Set CAFfyLabel             -- ^ SRT for this set
  -> DataCAFEnv                 -- Static data labels in this group
-  -> StateT ModuleSRTInfo UniqSM
+  -> StateT ModuleSRTInfo UniqDSM
       ( [CmmDeclSRTs]                -- SRT objects we built
       , [(Label, CLabel)]            -- SRT fields for these blocks' itbls
       , [(Label, [SRTEntry])]        -- SRTs to attach to static functions
@@ -1113,7 +1110,7 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data_env = do
    -- update the SRTMap for the label to point to a closure. It's
    -- important that we don't do this for static functions or CAFs,
    -- see Note [Invalid optimisation: shortcutting].
-    updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
+    updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqDSM ()
    updateSRTMap srtEntry =
      srtTrace "updateSRTMap"
        (pdoc platform srtEntry <+> "isCAF:" <+> ppr isCAF <+>
@@ -1237,7 +1234,7 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data_env = do
 buildSRTChain
   :: Profile
   -> [SRTEntry]
-   -> UniqSM
+   -> UniqDSM
        ( [CmmDeclSRTs] -- The SRT object(s)
        , SRTEntry      -- label to use in the info table
        )
@@ -1255,9 +1252,9 @@ buildSRTChain profile cafSet =
    mAX_SRT_SIZE = 16


-buildSRT :: Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
+buildSRT :: Profile -> [SRTEntry] -> UniqDSM (CmmDeclSRTs, SRTEntry)
 buildSRT profile refs = do
-  id <- getUniqueM
+  id <- getUniqueDSM
  let
    lbl = mkSRTLabel id
    platform = profilePlatform profile

--- a/compiler/GHC/Cmm/LRegSet.hs
+++ b/compiler/GHC/Cmm/LRegSet.hs
@@ -3,7 +3,6 @@

 module GHC.Cmm.LRegSet (
    LRegSet,
-    LRegKey,

    emptyLRegSet,
    nullLRegSet,
@@ -13,42 +12,52 @@ module GHC.Cmm.LRegSet (
    deleteFromLRegSet,
    sizeLRegSet,

-    plusLRegSet,
+    unionLRegSet,
+    unionsLRegSet,
    elemsLRegSet
  ) where

 import GHC.Prelude
 import GHC.Types.Unique
+import GHC.Types.Unique.Set
 import GHC.Cmm.Expr
-import GHC.Word
-
-import GHC.Data.Word64Set as Word64Set

 -- Compact sets for membership tests of local variables.

-type LRegSet = Word64Set.Word64Set
-type LRegKey = Word64
+type LRegSet = UniqueSet

+{-# INLINE emptyLRegSet #-}
 emptyLRegSet :: LRegSet
-emptyLRegSet = Word64Set.empty
+emptyLRegSet = emptyUniqueSet

+{-# INLINE nullLRegSet #-}
 nullLRegSet :: LRegSet -> Bool
-nullLRegSet = Word64Set.null
+nullLRegSet = nullUniqueSet

+{-# INLINE insertLRegSet #-}
 insertLRegSet :: LocalReg -> LRegSet -> LRegSet
-insertLRegSet l = Word64Set.insert (getKey (getUnique l))
+insertLRegSet l = insertUniqueSet (getUnique l)

+{-# INLINE elemLRegSet #-}
 elemLRegSet :: LocalReg -> LRegSet -> Bool
-elemLRegSet l = Word64Set.member (getKey (getUnique l))
+elemLRegSet l = memberUniqueSet (getUnique l)

+{-# INLINE deleteFromLRegSet #-}
 deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet
-deleteFromLRegSet set reg = Word64Set.delete (getKey . getUnique $ reg) set
+deleteFromLRegSet set reg = deleteUniqueSet (getUnique reg) set
+
+{-# INLINE sizeLRegSet #-}
+sizeLRegSet :: LRegSet -> Int
+sizeLRegSet = sizeUniqueSet

-sizeLRegSet :: Word64Set -> Int
-sizeLRegSet = Word64Set.size
+{-# INLINE unionLRegSet #-}
+unionLRegSet :: LRegSet -> LRegSet -> LRegSet
+unionLRegSet = unionUniqueSet

-plusLRegSet :: Word64Set -> Word64Set -> Word64Set
-plusLRegSet = Word64Set.union
+{-# INLINE unionsLRegSet #-}
+unionsLRegSet :: [LRegSet] -> LRegSet
+unionsLRegSet = unionsUniqueSet

-elemsLRegSet :: Word64Set -> [Word64]
-elemsLRegSet = Word64Set.toList
+{-# INLINE elemsLRegSet #-}
+elemsLRegSet :: LRegSet -> [Unique]
+elemsLRegSet = elemsUniqueSet
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
-{-# LANGUAGE BangPatterns, RecordWildCards, GADTs #-}
+{-# LANGUAGE RecordWildCards, GADTs #-}
 module GHC.Cmm.LayoutStack (
       cmmLayoutStack, setInfoTableStackMap
  ) where
@@ -8,7 +8,7 @@ import GHC.Prelude hiding ((<*>))
 import GHC.Platform
 import GHC.Platform.Profile

-import GHC.StgToCmm.Monad      ( newTemp  ) -- XXX layering violation
+import GHC.StgToCmm.Monad      ( newTemp ) -- XXX layering violation
 import GHC.StgToCmm.Utils      ( callerSaveVolatileRegs  ) -- XXX layering violation
 import GHC.StgToCmm.Foreign    ( saveThreadState, loadThreadState ) -- XXX layering violation

@@ -21,14 +21,13 @@ import GHC.Cmm.Graph
 import GHC.Cmm.Liveness
 import GHC.Cmm.ProcPoint
 import GHC.Runtime.Heap.Layout
-import GHC.Cmm.Dataflow.Block
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
+import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
-import GHC.Types.Unique.Supply
 import GHC.Data.Maybe
 import GHC.Types.Unique.FM
+import GHC.Types.Unique.DSM
 import GHC.Utils.Misc

 import GHC.Utils.Outputable hiding ( isEmpty )
@@ -37,6 +36,7 @@ import qualified Data.Set as Set
 import Control.Monad.Fix
 import Data.Array as Array
 import Data.List (nub)
+import Data.List.NonEmpty ( NonEmpty (..) )

 {- Note [Stack Layout]
   ~~~~~~~~~~~~~~~~~~~
@@ -236,7 +236,7 @@ instance Outputable StackMap where


 cmmLayoutStack :: CmmConfig -> ProcPointSet -> ByteOff -> CmmGraph
-               -> UniqSM (CmmGraph, LabelMap StackMap)
+               -> UniqDSM (CmmGraph, LabelMap StackMap)
 cmmLayoutStack cfg procpoints entry_args
               graph@(CmmGraph { g_entry = entry })
  = do
@@ -272,7 +272,7 @@ layout :: CmmConfig

       -> [CmmBlock]                    -- [in] blocks

-       -> UniqSM
+       -> UniqDSM
          ( LabelMap StackMap           -- [out] stack maps
          , ByteOff                     -- [out] Sp high water mark
          , [CmmBlock]                  -- [out] new blocks
@@ -283,12 +283,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)

@@ -341,7 +347,7 @@ layout cfg procpoints liveness entry entry_args final_stackmaps final_sp_high bl
           this_sp_hwm | isGcJump last0 = 0
                       | otherwise      = sp0 - sp_off

-           hwm' = maximum (acc_hwm : this_sp_hwm : map sm_sp (mapElems out))
+           hwm' = maximum (acc_hwm :| this_sp_hwm : map sm_sp (mapElems out))

       go bs acc_stackmaps' hwm' (final_blocks ++ acc_blocks)

@@ -368,7 +374,7 @@ isGcJump _something_else = False

 collectContInfo :: [CmmBlock] -> (ByteOff, LabelMap ByteOff)
 collectContInfo blocks
-  = (maximum ret_offs, mapFromList (catMaybes mb_argss))
+  = (maximum (expectNonEmpty ret_offs), mapFromList (catMaybes mb_argss))
 where
  (mb_argss, ret_offs) = mapAndUnzip get_cont blocks

@@ -437,7 +443,7 @@ handleLastNode
   -> LabelMap StackMap -> StackMap -> CmmTickScope
   -> Block CmmNode O O
   -> CmmNode O C
-   -> UniqSM
+   -> UniqDSM
      ( [CmmNode O O]      -- nodes to go *before* the Sp adjustment
      , ByteOff            -- amount to adjust Sp
      , CmmNode O C        -- new last node
@@ -503,7 +509,7 @@ handleLastNode cfg procpoints liveness cont_info stackmaps
     -- proc point, we have to set up the stack to match what the proc
     -- point is expecting.
     --
-     handleBranches :: UniqSM ( [CmmNode O O]
+     handleBranches :: UniqDSM ( [CmmNode O O]
                                , ByteOff
                                , CmmNode O C
                                , [CmmBlock]
@@ -536,7 +542,7 @@ handleLastNode cfg procpoints liveness cont_info stackmaps
                 , mapFromList [ (l, sm) | (l,_,sm,_) <- pps ] )

     -- For each successor of this block
-     handleBranch :: BlockId -> UniqSM (BlockId, BlockId, StackMap, [CmmBlock])
+     handleBranch :: BlockId -> UniqDSM (BlockId, BlockId, StackMap, [CmmBlock])
     handleBranch l
        --   (a) if the successor already has a stackmap, we need to
        --       shuffle the current stack to make it look the same.
@@ -571,7 +577,7 @@ handleLastNode cfg procpoints liveness cont_info stackmaps

 makeFixupBlock :: CmmConfig -> ByteOff -> Label -> StackMap
               -> CmmTickScope -> [CmmNode O O]
-               -> UniqSM (Label, [CmmBlock])
+               -> UniqDSM (Label, [CmmBlock])
 makeFixupBlock cfg sp0 l stack tscope assigs
  | null assigs && sp0 == sm_sp stack = return (l, [])
  | otherwise = do
@@ -1048,7 +1054,7 @@ insertReloadsAsNeeded
    -> LabelMap StackMap
    -> BlockId
    -> [CmmBlock]
-    -> UniqSM [CmmBlock]
+    -> UniqDSM [CmmBlock]
 insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks =
    toBlockList . fst <$>
        rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty
@@ -1134,7 +1140,7 @@ expecting them (see Note [safe foreign call convention]). Note also
 that safe foreign call is replace by an unsafe one in the Cmm graph.
 -}

-lowerSafeForeignCall :: Profile -> CmmBlock -> UniqSM CmmBlock
+lowerSafeForeignCall :: Profile -> CmmBlock -> UniqDSM CmmBlock
 lowerSafeForeignCall profile block
  | (entry@(CmmEntry _ tscp), middle, CmmForeignCall { .. }) <- blockSplit block
  = do
@@ -1181,7 +1187,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"

--- a/compiler/GHC/Cmm/Lexer.x
+++ b/compiler/GHC/Cmm/Lexer.x
@@ -18,6 +18,7 @@ module GHC.Cmm.Lexer (
 import GHC.Prelude

 import GHC.Cmm.Expr
+import GHC.Cmm.Reg (GlobalArgRegs(..))

 import GHC.Parser.Lexer
 import GHC.Cmm.Parser.Monad
@@ -62,7 +63,7 @@ $namechar  = [$namebegin $digit]
 @hexadecimal = $hexit+
 @exponent    = [eE] [\-\+]? @decimal

-@floating_point = @decimal \. @decimal @exponent? | @decimal @exponent
+@floating_point = [\-]? (@decimal \. @decimal @exponent? | @decimal @exponent)

 @escape      = \\ ([abfnrt\\\'\"\?] | x $hexit{1,2} | $octit{1,3})
 @strchar     = ($printable # [\"\\]) | @escape
@@ -104,11 +105,14 @@ $white_no_nl+           ;
  "False"               { kw CmmT_False }
  "likely"              { kw CmmT_likely}

-  P@decimal             { global_regN VanillaReg      gcWord }
-  R@decimal             { global_regN VanillaReg       bWord }
-  F@decimal             { global_regN FloatReg  (const $ cmmFloat W32) }
-  D@decimal             { global_regN DoubleReg (const $ cmmFloat W64) }
-  L@decimal             { global_regN LongReg   (const $ cmmBits  W64) }
+  P@decimal             { global_regN 1 VanillaReg      gcWord }
+  R@decimal             { global_regN 1 VanillaReg       bWord }
+  F@decimal             { global_regN 1 FloatReg  (const $ cmmFloat W32) }
+  D@decimal             { global_regN 1 DoubleReg (const $ cmmFloat W64) }
+  L@decimal             { global_regN 1 LongReg   (const $ cmmBits  W64) }
+  XMM@decimal           { global_regN 3 XmmReg    (const $ cmmVec 2 (cmmFloat W64)) }
+  YMM@decimal           { global_regN 3 YmmReg    (const $ cmmVec 4 (cmmFloat W64)) }
+  ZMM@decimal           { global_regN 3 ZmmReg    (const $ cmmVec 8 (cmmFloat W64)) }
  Sp                    { global_reg  Sp               bWord }
  SpLim                 { global_reg  SpLim            bWord }
  Hp                    { global_reg  Hp              gcWord }
@@ -121,6 +125,12 @@ $white_no_nl+           ;
  MachSp                { global_reg  MachSp           bWord }
  UnwindReturnReg       { global_reg  UnwindReturnReg  bWord }

+  GP_ARG_REGS           { kw (CmmT_GlobalArgRegs GP_ARG_REGS) }
+  SCALAR_ARG_REGS       { kw (CmmT_GlobalArgRegs SCALAR_ARG_REGS) }
+  V16_ARG_REGS          { kw (CmmT_GlobalArgRegs V16_ARG_REGS) }
+  V32_ARG_REGS          { kw (CmmT_GlobalArgRegs V32_ARG_REGS) }
+  V64_ARG_REGS          { kw (CmmT_GlobalArgRegs V64_ARG_REGS) }
+
  $namebegin $namechar* { name }

  0 @octal              { tok_octal }
@@ -173,17 +183,18 @@ data CmmToken
  | CmmT_bits16
  | CmmT_bits32
  | CmmT_bits64
-  | CmmT_bits128
-  | CmmT_bits256
-  | CmmT_bits512
+  | CmmT_vec128
+  | CmmT_vec256
+  | CmmT_vec512
  | CmmT_float32
  | CmmT_float64
  | CmmT_gcptr
-  | CmmT_GlobalReg GlobalRegUse
-  | CmmT_Name      FastString
-  | CmmT_String    String
-  | CmmT_Int       Integer
-  | CmmT_Float     Rational
+  | CmmT_GlobalReg     GlobalRegUse
+  | CmmT_GlobalArgRegs GlobalArgRegs
+  | CmmT_Name          FastString
+  | CmmT_String        String
+  | CmmT_Int           Integer
+  | CmmT_Float         Rational
  | CmmT_EOF
  | CmmT_False
  | CmmT_True
@@ -211,14 +222,16 @@ special_char span buf _len = return (L span (CmmT_SpecChar (currentChar buf)))
 kw :: CmmToken -> Action
 kw tok span _buf _len = return (L span tok)

-global_regN :: (Int -> GlobalReg) -> (Platform -> CmmType) -> Action
-global_regN con ty_fn span buf len
+global_regN :: Int -> (Int -> GlobalReg) -> (Platform -> CmmType) -> Action
+global_regN ident_nb_chars con ty_fn span buf len
  = do { platform <- getPlatform
       ; let reg = con (fromIntegral n)
             ty = ty_fn platform
       ; return (L span (CmmT_GlobalReg (GlobalRegUse reg ty))) }
-  where buf' = stepOn buf
-        n = parseUnsignedInteger buf' (len-1) 10 octDecDigit
+  where buf' = go ident_nb_chars buf
+          where go 0 b = b
+                go i b = go (i-1) (stepOn b)
+        n = parseUnsignedInteger buf' (len-ident_nb_chars) 10 octDecDigit

 global_reg :: GlobalReg -> (Platform -> CmmType) -> Action
 global_reg reg ty_fn span _buf _len
@@ -269,9 +282,9 @@ reservedWordsFM = listToUFM $
        ( "bits16",             CmmT_bits16 ),
        ( "bits32",             CmmT_bits32 ),
        ( "bits64",             CmmT_bits64 ),
-        ( "bits128",            CmmT_bits128 ),
-        ( "bits256",            CmmT_bits256 ),
-        ( "bits512",            CmmT_bits512 ),
+        ( "vec128",             CmmT_vec128 ),
+        ( "vec256",             CmmT_vec256 ),
+        ( "vec512",             CmmT_vec512 ),
        ( "float32",            CmmT_float32 ),
        ( "float64",            CmmT_float64 ),
 -- New forms
@@ -279,9 +292,6 @@ reservedWordsFM = listToUFM $
        ( "b16",                CmmT_bits16 ),
        ( "b32",                CmmT_bits32 ),
        ( "b64",                CmmT_bits64 ),
-        ( "b128",               CmmT_bits128 ),
-        ( "b256",               CmmT_bits256 ),
-        ( "b512",               CmmT_bits512 ),
        ( "f32",                CmmT_float32 ),
        ( "f64",                CmmT_float64 ),
        ( "gcptr",              CmmT_gcptr ),

--- a/compiler/GHC/Cmm/Lint.hs
+++ b/compiler/GHC/Cmm/Lint.hs
@@ -18,7 +18,6 @@ import GHC.Prelude
 import GHC.Platform
 import GHC.Platform.Regs (callerSaves)
 import GHC.Cmm.Dataflow.Block
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm
@@ -172,7 +171,7 @@ lintCmmMiddle node = case node of
  CmmAssign reg expr -> do
            erep <- lintCmmExpr expr
            let reg_ty = cmmRegType reg
-            unless (erep `cmmEqType_ignoring_ptrhood` reg_ty) $
+            unless (erep `cmmCompatType` reg_ty) $
              cmmLintAssignErr (CmmAssign reg expr) erep reg_ty

  CmmStore l r _alignment -> do

--- a/compiler/GHC/Cmm/Liveness.hs
+++ b/compiler/GHC/Cmm/Liveness.hs
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}

 module GHC.Cmm.Liveness
    ( CmmLocalLive
@@ -21,7 +18,6 @@ import GHC.Platform
 import GHC.Cmm.BlockId
 import GHC.Cmm
 import GHC.Cmm.Dataflow.Block
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.LRegSet
@@ -30,8 +26,6 @@ import GHC.Data.Maybe
 import GHC.Utils.Outputable
 import GHC.Utils.Panic

-import GHC.Types.Unique
-
 -----------------------------------------------------------------------------
 -- Calculating what variables are live on entry to a basic block
 -----------------------------------------------------------------------------
@@ -63,9 +57,9 @@ cmmLocalLiveness platform graph =
  where
    entry = g_entry graph
    check facts =
-        noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts
+        noLiveOnEntry entry (expectJust $ mapLookup entry facts) facts

-cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg
+cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalRegUse
 cmmGlobalLiveness platform graph =
    analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty

@@ -98,7 +92,7 @@ xferLive platform (BlockCC eNode middle xNode) fBase =
        !result = foldNodesBwdOO (gen_kill platform) middle joined
    in mapSingleton (entryLabel eNode) result
 {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-}
-{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-}
+{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalRegUse) #-}

 -----------------------------------------------------------------------------
 -- | Specialization that only retains the keys for local variables.
@@ -116,7 +110,7 @@ liveLatticeL :: DataflowLattice LRegSet
 liveLatticeL = DataflowLattice emptyLRegSet add
  where
    add (OldFact old) (NewFact new) =
-        let !join = plusLRegSet old new
+        let !join = unionLRegSet old new
        in changedIf (sizeLRegSet join > sizeLRegSet old) join


@@ -126,7 +120,7 @@ cmmLocalLivenessL platform graph =
  where
    entry = g_entry graph
    check facts =
-        noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts
+        noLiveOnEntryL entry (expectJust $ mapLookup entry facts) facts

 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
 noLiveOnEntryL :: BlockId -> LRegSet -> a -> a
@@ -136,7 +130,7 @@ noLiveOnEntryL bid in_fact x =
    where
        -- We convert the int's to uniques so that the printing matches that
        -- of registers.
-        reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact
+        reg_uniques = elemsLRegSet in_fact



@@ -161,4 +155,3 @@ xferLiveL platform (BlockCC eNode middle xNode) fBase =
        !result = foldNodesBwdOO (gen_killL platform) middle joined
    in mapSingleton (entryLabel eNode) result

-
--- a/compiler/GHC/Cmm/MachOp.hs
+++ b/compiler/GHC/Cmm/MachOp.hs
 {-# LANGUAGE LambdaCase #-}

-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-
 module GHC.Cmm.MachOp
    ( MachOp(..)
    , pprMachOp, isCommutableMachOp, isAssociativeMachOp
@@ -39,6 +37,9 @@ import GHC.Prelude
 import GHC.Platform
 import GHC.Cmm.Type
 import GHC.Utils.Outputable
+import GHC.Utils.Misc (expectNonEmpty)
+
+import Data.List.NonEmpty (NonEmpty (..))

 -----------------------------------------------------------------------------
 --              MachOp
@@ -73,7 +74,7 @@ assume that the code produced for a MachOp does not introduce new blocks.
 --
 -- (1) has the benefit that its interpretation is completely independent of the
 -- architecture. So, the mid-term plan is to migrate to this
-- interpretation/sematics.
+-- interpretation/semantics.

 data MachOp
  -- Integer operations (insensitive to signed/unsigned)
@@ -115,7 +116,7 @@ data MachOp

  -- Floating-point fused multiply-add operations
  -- | Fused multiply-add, see 'FMASign'.
-  | MO_FMA FMASign Width
+  | MO_FMA FMASign Length Width

  -- Floating point comparison
  | MO_F_Eq Width
@@ -125,6 +126,9 @@ data MachOp
  | MO_F_Gt Width
  | MO_F_Lt Width

+  | MO_F_Min Width
+  | MO_F_Max Width
+
  -- Bitwise operations.  Not all of these may be supported
  -- at all sizes, and only integral Widths are valid.
  | MO_And   Width
@@ -139,8 +143,8 @@ data MachOp

  -- Conversions.  Some of these will be NOPs.
  -- Floating-point conversions use the signed variant.
-  | MO_SF_Conv Width Width      -- Signed int -> Float
-  | MO_FS_Conv Width Width      -- Float -> Signed int
+  | MO_SF_Round    Width Width  -- Signed int -> Float
+  | MO_FS_Truncate Width Width  -- Float -> Signed int
  | MO_SS_Conv Width Width      -- Signed int -> Signed int
  | MO_UU_Conv Width Width      -- unsigned int -> unsigned int
  | MO_XX_Conv Width Width      -- int -> int; puts no requirements on the
@@ -151,11 +155,15 @@ data MachOp
                                -- MO_XX_Conv, e.g.,
                                --   MO_XX_CONV W64 W8 (MO_XX_CONV W8 W64 x)
                                -- is equivalent to just x.
-  | MO_FF_Conv Width Width      -- Float -> Float
+  | MO_FF_Conv Width Width      -- Float  -> Float
+
+  | MO_WF_Bitcast Width      -- Word32/Word64   -> Float/Double
+  | MO_FW_Bitcast Width      -- Float/Double  -> Word32/Word64

  -- Vector element insertion and extraction operations
-  | MO_V_Insert  Length Width   -- Insert scalar into vector
-  | MO_V_Extract Length Width   -- Extract scalar from vector
+  | MO_V_Broadcast Length Width -- Broadcast a scalar into a vector
+  | MO_V_Insert    Length Width -- Insert scalar into vector
+  | MO_V_Extract   Length Width -- Extract scalar from vector

  -- Integer vector operations
  | MO_V_Add Length Width
@@ -171,9 +179,14 @@ data MachOp
  | MO_VU_Quot Length Width
  | MO_VU_Rem  Length Width

+  -- Vector shuffles
+  | MO_V_Shuffle  Length Width [Int]
+  | MO_VF_Shuffle Length Width [Int]
+
  -- Floating point vector element insertion and extraction operations
-  | MO_VF_Insert  Length Width   -- Insert scalar into vector
-  | MO_VF_Extract Length Width   -- Extract scalar from vector
+  | MO_VF_Broadcast Length Width   -- Broadcast a scalar into a vector
+  | MO_VF_Insert    Length Width   -- Insert scalar into vector
+  | MO_VF_Extract   Length Width   -- Extract scalar from vector

  -- Floating point vector operations
  | MO_VF_Add  Length Width
@@ -182,6 +195,18 @@ data MachOp
  | MO_VF_Mul  Length Width
  | MO_VF_Quot Length Width

+  -- Min/max operations
+  | MO_VS_Min Length Width
+  | MO_VS_Max Length Width
+  | MO_VU_Min Length Width
+  | MO_VU_Max Length Width
+  | MO_VF_Min Length Width
+  | MO_VF_Max Length Width
+
+  -- | An atomic read with no memory ordering. Address msut
+  -- be naturally aligned.
+  | MO_RelaxedRead Width
+
  -- Alignment check (for -falignment-sanitisation)
  | MO_AlignmentCheck Int Width
  deriving (Eq, Show)
@@ -308,6 +333,8 @@ isCommutableMachOp mop =
        MO_Xor _                -> True
        MO_F_Add _              -> True
        MO_F_Mul _              -> True
+        MO_F_Min {}             -> True
+        MO_F_Max {}             -> True
        _other                  -> False

 -- ----------------------------------------------------------------------------
@@ -402,16 +429,16 @@ isFloatComparison mop =
 maybeInvertComparison :: MachOp -> Maybe MachOp
 maybeInvertComparison op
  = case op of  -- None of these Just cases include floating point
-        MO_Eq r   -> Just (MO_Ne r)
-        MO_Ne r   -> Just (MO_Eq r)
-        MO_U_Lt r -> Just (MO_U_Ge r)
-        MO_U_Gt r -> Just (MO_U_Le r)
-        MO_U_Le r -> Just (MO_U_Gt r)
-        MO_U_Ge r -> Just (MO_U_Lt r)
-        MO_S_Lt r -> Just (MO_S_Ge r)
-        MO_S_Gt r -> Just (MO_S_Le r)
-        MO_S_Le r -> Just (MO_S_Gt r)
-        MO_S_Ge r -> Just (MO_S_Lt r)
+        MO_Eq w   -> Just (MO_Ne w)
+        MO_Ne w   -> Just (MO_Eq w)
+        MO_U_Lt w -> Just (MO_U_Ge w)
+        MO_U_Gt w -> Just (MO_U_Le w)
+        MO_U_Le w -> Just (MO_U_Gt w)
+        MO_U_Ge w -> Just (MO_U_Lt w)
+        MO_S_Lt w -> Just (MO_S_Ge w)
+        MO_S_Gt w -> Just (MO_S_Le w)
+        MO_S_Le w -> Just (MO_S_Gt w)
+        MO_S_Ge w -> Just (MO_S_Lt w)
        _other    -> Nothing

 -- ----------------------------------------------------------------------------
@@ -425,13 +452,13 @@ machOpResultType platform mop tys =
  case mop of
    MO_Add {}           -> ty1  -- Preserve GC-ptr-hood
    MO_Sub {}           -> ty1  -- of first arg
-    MO_Mul    r         -> cmmBits r
-    MO_S_MulMayOflo r   -> cmmBits r
-    MO_S_Quot r         -> cmmBits r
-    MO_S_Rem  r         -> cmmBits r
-    MO_S_Neg  r         -> cmmBits r
-    MO_U_Quot r         -> cmmBits r
-    MO_U_Rem  r         -> cmmBits r
+    MO_Mul    w         -> cmmBits w
+    MO_S_MulMayOflo w   -> cmmBits w
+    MO_S_Quot w         -> cmmBits w
+    MO_S_Rem  w         -> cmmBits w
+    MO_S_Neg  w         -> cmmBits w
+    MO_U_Quot w         -> cmmBits w
+    MO_U_Rem  w         -> cmmBits w

    MO_Eq {}            -> comparisonResultRep platform
    MO_Ne {}            -> comparisonResultRep platform
@@ -445,13 +472,15 @@ machOpResultType platform mop tys =
    MO_U_Gt {}          -> comparisonResultRep platform
    MO_U_Lt {}          -> comparisonResultRep platform

-    MO_F_Add r          -> cmmFloat r
-    MO_F_Sub r          -> cmmFloat r
-    MO_F_Mul r          -> cmmFloat r
-    MO_F_Quot r         -> cmmFloat r
-    MO_F_Neg r          -> cmmFloat r
+    MO_F_Add w          -> cmmFloat w
+    MO_F_Sub w          -> cmmFloat w
+    MO_F_Mul w          -> cmmFloat w
+    MO_F_Quot w         -> cmmFloat w
+    MO_F_Neg w          -> cmmFloat w
+    MO_F_Min w          -> cmmFloat w
+    MO_F_Max w          -> cmmFloat w

-    MO_FMA _ r          -> cmmFloat r
+    MO_FMA _ l w        -> if l == 1 then cmmFloat w else cmmVec l (cmmFloat w)

    MO_F_Eq  {}         -> comparisonResultRep platform
    MO_F_Ne  {}         -> comparisonResultRep platform
@@ -463,18 +492,21 @@ machOpResultType platform mop tys =
    MO_And {}           -> ty1  -- Used for pointer masking
    MO_Or {}            -> ty1
    MO_Xor {}           -> ty1
-    MO_Not   r          -> cmmBits r
-    MO_Shl   r          -> cmmBits r
-    MO_U_Shr r          -> cmmBits r
-    MO_S_Shr r          -> cmmBits r
+    MO_Not   w          -> cmmBits w
+    MO_Shl   w          -> cmmBits w
+    MO_U_Shr w          -> cmmBits w
+    MO_S_Shr w          -> cmmBits w

    MO_SS_Conv _ to     -> cmmBits to
    MO_UU_Conv _ to     -> cmmBits to
    MO_XX_Conv _ to     -> cmmBits to
-    MO_FS_Conv _ to     -> cmmBits to
-    MO_SF_Conv _ to     -> cmmFloat to
+    MO_FS_Truncate _ to -> cmmBits to
+    MO_SF_Round _ to    -> cmmFloat to
    MO_FF_Conv _ to     -> cmmFloat to
+    MO_WF_Bitcast   w   -> cmmFloat w
+    MO_FW_Bitcast   w   -> cmmBits w

+    MO_V_Broadcast l w  -> cmmVec l (cmmBits w)
    MO_V_Insert  l w    -> cmmVec l (cmmBits w)
    MO_V_Extract _ w    -> cmmBits w

@@ -485,10 +517,18 @@ machOpResultType platform mop tys =
    MO_VS_Quot l w      -> cmmVec l (cmmBits w)
    MO_VS_Rem  l w      -> cmmVec l (cmmBits w)
    MO_VS_Neg  l w      -> cmmVec l (cmmBits w)
+    MO_VS_Min  l w      -> cmmVec l (cmmBits w)
+    MO_VS_Max  l w      -> cmmVec l (cmmBits w)

    MO_VU_Quot l w      -> cmmVec l (cmmBits w)
    MO_VU_Rem  l w      -> cmmVec l (cmmBits w)
+    MO_VU_Min  l w      -> cmmVec l (cmmBits w)
+    MO_VU_Max  l w      -> cmmVec l (cmmBits w)

+    MO_V_Shuffle  l w _ -> cmmVec l (cmmBits w)
+    MO_VF_Shuffle l w _ -> cmmVec l (cmmFloat w)
+
+    MO_VF_Broadcast l w -> cmmVec l (cmmFloat w)
    MO_VF_Insert  l w   -> cmmVec l (cmmFloat w)
    MO_VF_Extract _ w   -> cmmFloat w

@@ -497,10 +537,13 @@ machOpResultType platform mop tys =
    MO_VF_Mul  l w      -> cmmVec l (cmmFloat w)
    MO_VF_Quot l w      -> cmmVec l (cmmFloat w)
    MO_VF_Neg  l w      -> cmmVec l (cmmFloat w)
+    MO_VF_Min  l w      -> cmmVec l (cmmFloat w)
+    MO_VF_Max  l w      -> cmmVec l (cmmFloat w)

+    MO_RelaxedRead w    -> cmmBits w
    MO_AlignmentCheck _ _ -> ty1
  where
-    (ty1:_) = tys
+    ty1:|_ = expectNonEmpty tys

 comparisonResultRep :: Platform -> CmmType
 comparisonResultRep = bWord  -- is it?
@@ -517,82 +560,101 @@ comparisonResultRep = bWord  -- is it?
 machOpArgReps :: Platform -> MachOp -> [Width]
 machOpArgReps platform op =
  case op of
-    MO_Add    r         -> [r,r]
-    MO_Sub    r         -> [r,r]
-    MO_Eq     r         -> [r,r]
-    MO_Ne     r         -> [r,r]
-    MO_Mul    r         -> [r,r]
-    MO_S_MulMayOflo r   -> [r,r]
-    MO_S_Quot r         -> [r,r]
-    MO_S_Rem  r         -> [r,r]
-    MO_S_Neg  r         -> [r]
-    MO_U_Quot r         -> [r,r]
-    MO_U_Rem  r         -> [r,r]
-
-    MO_S_Ge r           -> [r,r]
-    MO_S_Le r           -> [r,r]
-    MO_S_Gt r           -> [r,r]
-    MO_S_Lt r           -> [r,r]
-
-    MO_U_Ge r           -> [r,r]
-    MO_U_Le r           -> [r,r]
-    MO_U_Gt r           -> [r,r]
-    MO_U_Lt r           -> [r,r]
-
-    MO_F_Add r          -> [r,r]
-    MO_F_Sub r          -> [r,r]
-    MO_F_Mul r          -> [r,r]
-    MO_F_Quot r         -> [r,r]
-    MO_F_Neg r          -> [r]
-
-    MO_FMA _ r          -> [r,r,r]
-
-    MO_F_Eq  r          -> [r,r]
-    MO_F_Ne  r          -> [r,r]
-    MO_F_Ge  r          -> [r,r]
-    MO_F_Le  r          -> [r,r]
-    MO_F_Gt  r          -> [r,r]
-    MO_F_Lt  r          -> [r,r]
-
-    MO_And   r          -> [r,r]
-    MO_Or    r          -> [r,r]
-    MO_Xor   r          -> [r,r]
-    MO_Not   r          -> [r]
-    MO_Shl   r          -> [r, wordWidth platform]
-    MO_U_Shr r          -> [r, wordWidth platform]
-    MO_S_Shr r          -> [r, wordWidth platform]
-
-    MO_SS_Conv from _   -> [from]
-    MO_UU_Conv from _   -> [from]
-    MO_XX_Conv from _   -> [from]
-    MO_SF_Conv from _   -> [from]
-    MO_FS_Conv from _   -> [from]
-    MO_FF_Conv from _   -> [from]
-
-    MO_V_Insert   l r   -> [typeWidth (vec l (cmmBits r)),r, W32]
-    MO_V_Extract  l r   -> [typeWidth (vec l (cmmBits r)), W32]
-    MO_VF_Insert  l r   -> [typeWidth (vec l (cmmFloat r)),r,W32]
-    MO_VF_Extract l r   -> [typeWidth (vec l (cmmFloat r)),W32]
+    MO_Add    w         -> [w,w]
+    MO_Sub    w         -> [w,w]
+    MO_Eq     w         -> [w,w]
+    MO_Ne     w         -> [w,w]
+    MO_Mul    w         -> [w,w]
+    MO_S_MulMayOflo w   -> [w,w]
+    MO_S_Quot w         -> [w,w]
+    MO_S_Rem  w         -> [w,w]
+    MO_S_Neg  w         -> [w]
+    MO_U_Quot w         -> [w,w]
+    MO_U_Rem  w         -> [w,w]
+
+    MO_S_Ge w           -> [w,w]
+    MO_S_Le w           -> [w,w]
+    MO_S_Gt w           -> [w,w]
+    MO_S_Lt w           -> [w,w]
+
+    MO_U_Ge w           -> [w,w]
+    MO_U_Le w           -> [w,w]
+    MO_U_Gt w           -> [w,w]
+    MO_U_Lt w           -> [w,w]
+
+    MO_F_Add w          -> [w,w]
+    MO_F_Sub w          -> [w,w]
+    MO_F_Mul w          -> [w,w]
+    MO_F_Quot w         -> [w,w]
+    MO_F_Neg w          -> [w]
+    MO_F_Min w          -> [w,w]
+    MO_F_Max w          -> [w,w]
+
+    MO_FMA _ l w        -> [vecwidth l w, vecwidth l w, vecwidth l w]
+
+    MO_F_Eq  w          -> [w,w]
+    MO_F_Ne  w          -> [w,w]
+    MO_F_Ge  w          -> [w,w]
+    MO_F_Le  w          -> [w,w]
+    MO_F_Gt  w          -> [w,w]
+    MO_F_Lt  w          -> [w,w]
+
+    MO_And   w          -> [w,w]
+    MO_Or    w          -> [w,w]
+    MO_Xor   w          -> [w,w]
+    MO_Not   w          -> [w]
+    MO_Shl   w          -> [w, wordWidth platform]
+    MO_U_Shr w          -> [w, wordWidth platform]
+    MO_S_Shr w          -> [w, wordWidth platform]
+
+    MO_SS_Conv from _     -> [from]
+    MO_UU_Conv from _     -> [from]
+    MO_XX_Conv from _     -> [from]
+    MO_SF_Round from _    -> [from]
+    MO_FS_Truncate from _ -> [from]
+    MO_FF_Conv from _     -> [from]
+    MO_WF_Bitcast w       -> [w]
+    MO_FW_Bitcast w       -> [w]
+
+    MO_V_Shuffle  l w _ -> [vecwidth l w, vecwidth l w]
+    MO_VF_Shuffle l w _ -> [vecwidth l w, vecwidth l w]
+
+    MO_V_Broadcast _ w  -> [w]
+    MO_V_Insert   l w   -> [vecwidth l w, w, W32]
+    MO_V_Extract  l w   -> [vecwidth l w, W32]
+    MO_VF_Broadcast _ w -> [w]
+    MO_VF_Insert  l w   -> [vecwidth l w, w, W32]
+    MO_VF_Extract l w   -> [vecwidth l w, W32]
      -- SIMD vector indices are always 32 bit

-    MO_V_Add _ r        -> [r,r]
-    MO_V_Sub _ r        -> [r,r]
-    MO_V_Mul _ r        -> [r,r]
-
-    MO_VS_Quot _ r      -> [r,r]
-    MO_VS_Rem  _ r      -> [r,r]
-    MO_VS_Neg  _ r      -> [r]
-
-    MO_VU_Quot _ r      -> [r,r]
-    MO_VU_Rem  _ r      -> [r,r]
-
-    MO_VF_Add  _ r      -> [r,r]
-    MO_VF_Sub  _ r      -> [r,r]
-    MO_VF_Mul  _ r      -> [r,r]
-    MO_VF_Quot _ r      -> [r,r]
-    MO_VF_Neg  _ r      -> [r]
-
-    MO_AlignmentCheck _ r -> [r]
+    MO_V_Add l w        -> [vecwidth l w, vecwidth l w]
+    MO_V_Sub l w        -> [vecwidth l w, vecwidth l w]
+    MO_V_Mul l w        -> [vecwidth l w, vecwidth l w]
+
+    MO_VS_Quot l w      -> [vecwidth l w, vecwidth l w]
+    MO_VS_Rem  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VS_Neg  l w      -> [vecwidth l w]
+    MO_VS_Min  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VS_Max  l w      -> [vecwidth l w, vecwidth l w]
+
+    MO_VU_Quot l w      -> [vecwidth l w, vecwidth l w]
+    MO_VU_Rem  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VU_Min  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VU_Max  l w      -> [vecwidth l w, vecwidth l w]
+
+    -- NOTE: The below is owing to the fact that floats use the SSE registers
+    MO_VF_Add  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VF_Sub  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VF_Mul  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VF_Quot l w      -> [vecwidth l w, vecwidth l w]
+    MO_VF_Neg  l w      -> [vecwidth l w]
+    MO_VF_Min  l w      -> [vecwidth l w, vecwidth l w]
+    MO_VF_Max  l w      -> [vecwidth l w, vecwidth l w]
+
+    MO_RelaxedRead _    -> [wordWidth platform]
+    MO_AlignmentCheck _ w -> [w]
+  where
+    vecwidth l w = widthFromBytes (l * widthInBytes w)

 -----------------------------------------------------------------------------
 -- CallishMachOp
@@ -721,6 +783,7 @@ data CallishMachOp

  | MO_AcquireFence
  | MO_ReleaseFence
+  | MO_SeqCstFence

  -- | Atomic read-modify-write. Arguments are @[dest, n]@.
  | MO_AtomicRMW Width AtomicMachOp

--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE LambdaCase #-}

@@ -41,7 +35,6 @@ import GHC.Types.Basic (FunctionOrData(..))
 import GHC.Platform
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import Data.Foldable (toList)
 import Data.Functor.Classes (liftCompare)
@@ -125,7 +118,7 @@ data CmmNode e x where
          -- occur in CmmExprs, namely as (CmmLit (CmmBlock b)) or
          -- (CmmStackSlot (Young b) _).

-      cml_args_regs :: [GlobalReg],
+      cml_args_regs :: [GlobalRegUse],
          -- The argument GlobalRegs (Rx, Fx, Dx, Lx) that are passed
          -- to the call.  This is essential information for the
          -- native code generator's register allocator; without
@@ -509,7 +502,7 @@ pprForeignTarget platform (PrimTarget op)
 = pdoc platform
               (mkForeignLabel
                          (mkFastString (show op))
-                          Nothing ForeignLabelInThisPackage IsFunction)
+                          ForeignLabelInThisPackage IsFunction)

 instance Outputable Convention where
  ppr = pprConvention
@@ -551,7 +544,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where
               => (b -> LocalReg -> b) -> b -> a -> b
          fold f z n = foldRegsUsed platform f z n

-instance UserOfRegs GlobalReg (CmmNode e x) where
+instance UserOfRegs GlobalRegUse (CmmNode e x) where
  {-# INLINEABLE foldRegsUsed #-}
  foldRegsUsed platform f !z n = case n of
    CmmAssign _ expr -> fold f z expr
@@ -562,8 +555,8 @@ instance UserOfRegs GlobalReg (CmmNode e x) where
    CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt
    CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
    _ -> z
-    where fold :: forall a b.  UserOfRegs GlobalReg a
-               => (b -> GlobalReg -> b) -> b -> a -> b
+    where fold :: forall a b.  UserOfRegs GlobalRegUse a
+               => (b -> GlobalRegUse -> b) -> b -> a -> b
          fold f z n = foldRegsUsed platform f z n
 instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where
  -- The (Ord r) in the context is necessary here
@@ -583,7 +576,7 @@ instance DefinerOfRegs LocalReg (CmmNode e x) where
               => (b -> LocalReg -> b) -> b -> a -> b
          fold f z n = foldRegsDefd platform f z n

-instance DefinerOfRegs GlobalReg (CmmNode e x) where
+instance DefinerOfRegs GlobalRegUse (CmmNode e x) where
  {-# INLINEABLE foldRegsDefd #-}
  foldRegsDefd platform f !z n = case n of
    CmmAssign lhs _ -> fold f z lhs
@@ -592,12 +585,13 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where
    CmmForeignCall {} -> fold f z activeRegs
                      -- See Note [Safe foreign calls clobber STG registers]
    _ -> z
-    where fold :: forall a b. DefinerOfRegs GlobalReg a
-               => (b -> GlobalReg -> b) -> b -> a -> b
+    where fold :: forall a b. DefinerOfRegs GlobalRegUse a
+               => (b -> GlobalRegUse -> b) -> b -> a -> b
          fold f z n = foldRegsDefd platform f z n

-          activeRegs = activeStgRegs platform
-          activeCallerSavesRegs = filter (callerSaves platform) activeRegs
+          activeRegs :: [GlobalRegUse]
+          activeRegs = map (\ r -> GlobalRegUse r (globalRegSpillType platform r)) $ activeStgRegs platform
+          activeCallerSavesRegs = filter (callerSaves platform . globalRegUse_reg) activeRegs

          foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = []
          foreignTargetRegs _ = activeCallerSavesRegs

--- a/compiler/GHC/Cmm/Opt.hs
+++ b/compiler/GHC/Cmm/Opt.hs
@@ -5,7 +5,6 @@
 -- (c) The University of Glasgow 2006
 --
 -----------------------------------------------------------------------------
-
 module GHC.Cmm.Opt (
        constantFoldNode,
        constantFoldExpr,
@@ -20,9 +19,11 @@ import GHC.Cmm
 import GHC.Utils.Misc

 import GHC.Utils.Panic
+import GHC.Utils.Outputable
 import GHC.Platform

 import Data.Maybe
+import GHC.Float


 constantFoldNode :: Platform -> CmmNode e x -> CmmNode e x
@@ -55,22 +56,60 @@ cmmMachOpFoldM
    -> MachOp
    -> [CmmExpr]
    -> Maybe CmmExpr
-
+cmmMachOpFoldM _ (MO_V_Broadcast lg _w) exprs =
+  case exprs of
+    [CmmLit l] -> Just $! CmmLit (CmmVec $ replicate lg l)
+    _ -> Nothing
+cmmMachOpFoldM _ (MO_VF_Broadcast lg _w) exprs =
+  case exprs of
+    [CmmLit l] -> Just $! CmmLit (CmmVec $ replicate lg l)
+    _ -> Nothing
 cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
+  | MO_WF_Bitcast width <- op = case width of
+      W32 | res <- castWord32ToFloat (fromInteger x)
+          -- Since we store float literals as Rationals
+          -- we must check for the usual tricky cases first
+          , not (isNegativeZero res || isNaN res || isInfinite res)
+          -- (round-tripping subnormals is not a problem)
+          , !res_rat <- toRational res
+            -> Just (CmmLit (CmmFloat res_rat W32))
+
+      W64 | res <- castWord64ToDouble (fromInteger x)
+          -- Since we store float literals as Rationals
+          -- we must check for the usual tricky cases first
+          , not (isNegativeZero res || isNaN res || isInfinite res)
+          -- (round-tripping subnormals is not a problem)
+          , !res_rat <- toRational res
+            -> Just (CmmLit (CmmFloat res_rat W64))
+
+      _ -> Nothing
+  | otherwise
  = Just $! case op of
-      MO_S_Neg _ -> CmmLit (CmmInt (-x) rep)
+      MO_S_Neg _ -> CmmLit (CmmInt (narrowS rep (-x)) rep)
      MO_Not _   -> CmmLit (CmmInt (complement x) rep)

        -- these are interesting: we must first narrow to the
        -- "from" type, in order to truncate to the correct size.
        -- The final narrow/widen to the destination type
        -- is implicit in the CmmLit.
-      MO_SF_Conv _from to -> CmmLit (CmmFloat (fromInteger x) to)
+      MO_SF_Round _frm to -> CmmLit (CmmFloat (fromInteger x) to)
      MO_SS_Conv  from to -> CmmLit (CmmInt (narrowS from x) to)
      MO_UU_Conv  from to -> CmmLit (CmmInt (narrowU from x) to)
      MO_XX_Conv  from to -> CmmLit (CmmInt (narrowS from x) to)

+      MO_F_Neg{}          -> invalidArgPanic
+      MO_FS_Truncate{}    -> invalidArgPanic
+      MO_FF_Conv{}        -> invalidArgPanic
+      MO_FW_Bitcast{}     -> invalidArgPanic
+      MO_VS_Neg{}         -> invalidArgPanic
+      MO_VF_Neg{}         -> invalidArgPanic
+      MO_RelaxedRead{}    -> invalidArgPanic
+      MO_AlignmentCheck{} -> invalidArgPanic
+
      _ -> panic $ "cmmMachOpFoldM: unknown unary op: " ++ show op
+      where invalidArgPanic = pprPanic "cmmMachOpFoldM" $
+              text "Found" <+> pprMachOp op
+                <+> text "illegally applied to an int literal"

 -- Eliminate shifts that are wider than the shiftee
 cmmMachOpFoldM _ op [_shiftee, CmmLit (CmmInt shift _)]
@@ -135,9 +174,9 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
        MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s <  y_s then 1 else 0) (wordWidth platform))
        MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform))

-        MO_Add r -> Just $! CmmLit (CmmInt (x + y) r)
-        MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r)
-        MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r)
+        MO_Add r -> Just $! CmmLit (CmmInt (narrowU r $ x + y) r)
+        MO_Sub r -> Just $! CmmLit (CmmInt (narrowS r $ x - y) r)
+        MO_Mul r -> Just $! CmmLit (CmmInt (narrowU r $ x * y) r)
        MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r)
        MO_U_Rem  r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem`  y_u) r)
        MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_s `quot` y_s) r)
@@ -147,7 +186,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
        MO_Or    r -> Just $! CmmLit (CmmInt (x .|. y) r)
        MO_Xor   r -> Just $! CmmLit (CmmInt (x `xor` y) r)

-        MO_Shl   r -> Just $! CmmLit (CmmInt (x   `shiftL` fromIntegral y) r)
+        MO_Shl   r -> Just $! CmmLit (CmmInt (narrowU r $ x   `shiftL` fromIntegral y) r)
        MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
        MO_S_Shr r -> Just $! CmmLit (CmmInt (x_s `shiftR` fromIntegral y) r)

@@ -213,23 +252,33 @@ cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op@MO_Add{} [pic, CmmLit lit]
  = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]
  where off = fromIntegral (narrowS rep n)

-- Make a RegOff if we can
+-- Make a RegOff if we can. We don't perform this optimization if rep is greater
+-- than the host word size because we use an Int to store the offset. See
+-- #24893 and #24700. This should be fixed to ensure that optimizations don't
+-- depend on the compiler host platform.
 cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
  = Just $! cmmRegOff reg (fromIntegral (narrowS rep n))
 cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
  = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n))
 cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
  = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n))
 cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
  = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n))

 -- Fold label(+/-)offset into a CmmLit where possible

 cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)]
+  | validOffsetRep rep
  = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
 cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit]
+  | validOffsetRep rep
  = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
 cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)]
+  | validOffsetRep rep
  = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i))))


@@ -410,6 +459,13 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))]

 cmmMachOpFoldM _ _ _ = Nothing

+-- | Check that a literal width is compatible with the host word size used to
+-- store offsets. This should be fixed properly (using larger types to store
+-- literal offsets). See #24893
+validOffsetRep :: Width -> Bool
+validOffsetRep rep = widthInBits rep <= finiteBitSize (undefined :: Int)
+
+
 {- Note [Comparison operators]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we have
@@ -420,7 +476,6 @@ we really want to convert to
 That's what the constant-folding operations on comparison operators do above.
 -}

-
 -- -----------------------------------------------------------------------------
 -- Utils


--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -198,8 +198,9 @@ Memory ordering
 ---------------

 Cmm respects the C11 memory model and distinguishes between non-atomic and
-atomic memory accesses. In C11 fashion, atomic accesses can provide a number of
-memory ordering guarantees. These are supported in Cmm syntax as follows:
+atomic memory accesses. In C11 fashion, atomic accesses can provide a variety of
+memory ordering guarantees. These supported as statements in Cmm syntax as
+follows:

    W_[ptr] = ...;            // a non-atomic store
    %relaxed W_[ptr] = ...;   // an atomic store with relaxed ordering semantics
@@ -214,6 +215,18 @@ memory ordering guarantees. These are supported in Cmm syntax as follows:
 Here we used W_ as an example but these operations can be used on all Cmm
 types.

+Sometimes it is also necessary to perform atomic but non-ordered loads in an
+expression context. For this we provide the MO_RelaxedRead MachOp, expressed in
+Cmm syntax as
+
+    x = W_![ptr];
+
+This operation and syntax was primarily added to support hand-written Cmm,
+where sometimes such atomic loads are unavoidable deep inside expressions (e.g.
+see the CHECK_GC macro). Since one should be explicit about program order when
+writing operations with ordered semantics, we do not provide similar MachOps
+for acquire and release reads.
+
 See Note [Heap memory barriers] in SMP.h for details.

 ----------------------------------------------------------------------------- -}
@@ -250,6 +263,7 @@ import GHC.StgToCmm.InfoTableProv
 import GHC.Cmm.Opt
 import GHC.Cmm.Graph
 import GHC.Cmm
+import GHC.Cmm.Reg        ( GlobalArgRegs(..) )
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch     ( mkSwitchTargets )
 import GHC.Cmm.Info
@@ -265,6 +279,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
@@ -368,9 +383,9 @@ import qualified Data.ByteString.Char8 as BS8
        'bits16'        { L _ (CmmT_bits16) }
        'bits32'        { L _ (CmmT_bits32) }
        'bits64'        { L _ (CmmT_bits64) }
-        'bits128'       { L _ (CmmT_bits128) }
-        'bits256'       { L _ (CmmT_bits256) }
-        'bits512'       { L _ (CmmT_bits512) }
+        'vec128'        { L _ (CmmT_vec128) }
+        'vec256'        { L _ (CmmT_vec256) }
+        'vec512'        { L _ (CmmT_vec512) }
        'float32'       { L _ (CmmT_float32) }
        'float64'       { L _ (CmmT_float64) }
        'gcptr'         { L _ (CmmT_gcptr) }
@@ -381,6 +396,12 @@ import qualified Data.ByteString.Char8 as BS8
        INT             { L _ (CmmT_Int       $$) }
        FLOAT           { L _ (CmmT_Float     $$) }

+        GP_ARG_REGS     { L _ (CmmT_GlobalArgRegs GP_ARG_REGS) }
+        SCALAR_ARG_REGS { L _ (CmmT_GlobalArgRegs SCALAR_ARG_REGS) }
+        V16_ARG_REGS    { L _ (CmmT_GlobalArgRegs V16_ARG_REGS) }
+        V32_ARG_REGS    { L _ (CmmT_GlobalArgRegs V32_ARG_REGS) }
+        V64_ARG_REGS    { L _ (CmmT_GlobalArgRegs V64_ARG_REGS) }
+
 %monad { PD } { >>= } { return }
 %lexer { cmmlex } { L _ CmmT_EOF }
 %name cmmParse cmm
@@ -457,7 +478,7 @@ static  :: { CmmParse [CmmStatic] }
                { do { lits <- sequence $4
                ; profile <- getProfile
                     ; return $ map CmmStaticLit $
-                        mkStaticClosure profile (mkForeignLabel $3 Nothing ForeignLabelInExternalPackage IsData)
+                        mkStaticClosure profile (mkForeignLabel $3 ForeignLabelInExternalPackage IsData)
                         -- mkForeignLabel because these are only used
                         -- for CHARLIKE and INTLIKE closures in the RTS.
                        dontCareCCS (map getLit lits) [] [] [] [] } }
@@ -627,11 +648,11 @@ importName
        -- A label imported without an explicit packageId.
        --      These are taken to come from some foreign, unnamed package.
        : NAME
-        { ($1, mkForeignLabel $1 Nothing ForeignLabelInExternalPackage IsFunction) }
+        { ($1, mkForeignLabel $1 ForeignLabelInExternalPackage IsFunction) }

        -- as previous 'NAME', but 'IsData'
        | 'CLOSURE' NAME
-        { ($2, mkForeignLabel $2 Nothing ForeignLabelInExternalPackage IsData) }
+        { ($2, mkForeignLabel $2 ForeignLabelInExternalPackage IsData) }

        -- A label imported with an explicit UnitId.
        | STRING NAME
@@ -714,9 +735,9 @@ stmt    :: { CmmParse () }
 unwind_regs
        :: { CmmParse [(GlobalReg, Maybe CmmExpr)] }
        : GLOBALREG '=' expr_or_unknown ',' unwind_regs
-                { do e <- $3; rest <- $5; return ((globalRegUseGlobalReg $1, e) : rest) }
+                { do e <- $3; rest <- $5; return ((globalRegUse_reg $1, e) : rest) }
        | GLOBALREG '=' expr_or_unknown
-                { do e <- $3; return [(globalRegUseGlobalReg $1, e)] }
+                { do e <- $3; return [(globalRegUse_reg $1, e)] }

 -- | A memory ordering
 mem_ordering :: { CmmParse MemoryOrdering }
@@ -735,7 +756,7 @@ expr_or_unknown
                { do e <- $1; return (Just e) }

 foreignLabel     :: { CmmParse CmmExpr }
-        : NAME                          { return (CmmLit (CmmLabel (mkForeignLabel $1 Nothing ForeignLabelInThisPackage IsFunction))) }
+        : NAME                          { return (CmmLit (CmmLabel (mkForeignLabel $1 ForeignLabelInThisPackage IsFunction))) }

 opt_never_returns :: { CmmReturnInfo }
        :                               { CmmMayReturn }
@@ -757,13 +778,29 @@ safety  :: { Safety }
        : {- empty -}                   { PlayRisky }
        | STRING                        {% parseSafety $1 }

-vols    :: { [GlobalReg] }
+vols    :: { [GlobalRegUse] }
        : '[' ']'                       { [] }
-        | '[' '*' ']'                   {% do platform <- PD.getPlatform
-                                         ; return (realArgRegsCover platform) }
-                                           -- All of them. See comment attached
-                                           -- to realArgRegsCover
-        | '[' globals ']'               { map globalRegUseGlobalReg $2 }
+        | GP_ARG_REGS                   {% do platform <- PD.getPlatform;
+                                              return
+                                                [ GlobalRegUse r (globalRegSpillType platform r)
+                                                | r <- realArgRegsCover platform GP_ARG_REGS ] }
+        | SCALAR_ARG_REGS               {% do platform <- PD.getPlatform;
+                                              return
+                                                [ GlobalRegUse r (globalRegSpillType platform r)
+                                                | r <- realArgRegsCover platform SCALAR_ARG_REGS ] }
+        | V16_ARG_REGS                  {% do platform <- PD.getPlatform;
+                                              return
+                                                [ GlobalRegUse r (globalRegSpillType platform r)
+                                                | r <- realArgRegsCover platform V16_ARG_REGS ] }
+        | V32_ARG_REGS                  {% do platform <- PD.getPlatform;
+                                              return
+                                                [ GlobalRegUse r (globalRegSpillType platform r)
+                                                | r <- realArgRegsCover platform V32_ARG_REGS ] }
+        | V64_ARG_REGS                  {% do platform <- PD.getPlatform;
+                                              return
+                                                [ GlobalRegUse r (globalRegSpillType platform r)
+                                                | r <- realArgRegsCover platform V64_ARG_REGS ] }
+        | '[' globals ']'               { $2 }

 globals :: { [GlobalRegUse] }
        : GLOBALREG                     { [$1] }
@@ -837,14 +874,12 @@ expr0   :: { CmmParse CmmExpr }
        | STRING                 { do s <- code (newStringCLit $1);
                                      return (CmmLit s) }
        | reg                    { $1 }
-        | type dereference       { do (align, ptr) <- $2; return (CmmLoad ptr $1 align) }
+        | type '!' '[' expr ']'  { do ptr <- $4; return (CmmMachOp (MO_RelaxedRead (typeWidth $1)) [ptr]) }
+        | type '^' '[' expr ']'  { do ptr <- $4; return (CmmLoad ptr $1 Unaligned) }
+        | type '[' expr ']'      { do ptr <- $3; return (CmmLoad ptr $1 NaturallyAligned) }
        | '%' NAME '(' exprs0 ')' {% exprOp $2 $4 }
        | '(' expr ')'           { $2 }

-dereference :: { CmmParse (AlignmentSpec, CmmExpr) }
-        : '^' '[' expr ']'       { do ptr <- $3; return (Unaligned, ptr) }
-        | '[' expr ']'           { do ptr <- $2; return (NaturallyAligned, ptr) }
-
 -- leaving out the type of a literal gives you the native word size in C--
 maybe_ty :: { CmmType }
        : {- empty -}                   {% do platform <- PD.getPlatform; return $ bWord platform }
@@ -931,9 +966,9 @@ typenot8 :: { CmmType }
        : 'bits16'              { b16 }
        | 'bits32'              { b32 }
        | 'bits64'              { b64 }
-        | 'bits128'             { b128 }
-        | 'bits256'             { b256 }
-        | 'bits512'             { b512 }
+        | 'vec128'              { cmmVec 2 f64 }
+        | 'vec256'              { cmmVec 4 f64 }
+        | 'vec512'              { cmmVec 8 f64 }
        | 'float32'             { f32 }
        | 'float64'             { f64 }
        | 'gcptr'               {% do platform <- PD.getPlatform; return $ gcWord platform }
@@ -1039,11 +1074,13 @@ machOps = listToUFM $
        ( "fneg",       MO_F_Neg ),
        ( "fmul",       MO_F_Mul ),
        ( "fquot",      MO_F_Quot ),
+        ( "fmin",       MO_F_Min ),
+        ( "fmax",       MO_F_Max ),

-        ( "fmadd" ,     MO_FMA FMAdd  ),
-        ( "fmsub" ,     MO_FMA FMSub  ),
-        ( "fnmadd",     MO_FMA FNMAdd ),
-        ( "fnmsub",     MO_FMA FNMSub ),
+        ( "fmadd" ,     MO_FMA FMAdd  1 ),
+        ( "fmsub" ,     MO_FMA FMSub  1 ),
+        ( "fnmadd",     MO_FMA FNMAdd 1 ),
+        ( "fnmsub",     MO_FMA FNMSub 1 ),

        ( "feq",        MO_F_Eq ),
        ( "fne",        MO_F_Ne ),
@@ -1067,12 +1104,15 @@ machOps = listToUFM $

        ( "f2f32",    flip MO_FF_Conv W32 ),  -- TODO; rounding mode
        ( "f2f64",    flip MO_FF_Conv W64 ),  -- TODO; rounding mode
-        ( "f2i8",     flip MO_FS_Conv W8 ),
-        ( "f2i16",    flip MO_FS_Conv W16 ),
-        ( "f2i32",    flip MO_FS_Conv W32 ),
-        ( "f2i64",    flip MO_FS_Conv W64 ),
-        ( "i2f32",    flip MO_SF_Conv W32 ),
-        ( "i2f64",    flip MO_SF_Conv W64 )
+        ( "f2i8",     flip MO_FS_Truncate W8 ),
+        ( "f2i16",    flip MO_FS_Truncate W16 ),
+        ( "f2i32",    flip MO_FS_Truncate W32 ),
+        ( "f2i64",    flip MO_FS_Truncate W64 ),
+        ( "i2f32",    flip MO_SF_Round W32 ),
+        ( "i2f64",    flip MO_SF_Round W64 ),
+
+        ( "w2f_bitcast", MO_WF_Bitcast ),
+        ( "f2w_bitcast", MO_FW_Bitcast )
        ]

 callishMachOps :: Platform -> UniqFM FastString ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
@@ -1122,6 +1162,8 @@ callishMachOps platform = listToUFM $
        -- with an overlapping token ('acquire') in the lexer.
        ( "fence_acquire", (MO_AcquireFence,)),
        ( "fence_release", (MO_ReleaseFence,)),
+        ( "fence_seq_cst", (MO_SeqCstFence,)),
+
        ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ),
        ( "memset", memcpyLikeTweakArgs MO_Memset ),
        ( "memmove", memcpyLikeTweakArgs MO_Memmove ),
@@ -1133,7 +1175,11 @@ callishMachOps platform = listToUFM $
        ( "prefetch0", (MO_Prefetch_Data 0,)),
        ( "prefetch1", (MO_Prefetch_Data 1,)),
        ( "prefetch2", (MO_Prefetch_Data 2,)),
-        ( "prefetch3", (MO_Prefetch_Data 3,))
+        ( "prefetch3", (MO_Prefetch_Data 3,)),
+
+        ( "bswap16", (MO_BSwap W16,) ),
+        ( "bswap32", (MO_BSwap W32,) ),
+        ( "bswap64", (MO_BSwap W64,) )
    ] ++ concat
    [ allWidths "popcnt" MO_PopCnt
    , allWidths "pdep" MO_Pdep
@@ -1151,6 +1197,8 @@ callishMachOps platform = listToUFM $
    , allWidths "fetch_nand" (\w -> MO_AtomicRMW w AMO_Nand)
    , allWidths "fetch_or" (\w -> MO_AtomicRMW w AMO_Or)
    , allWidths "fetch_xor" (\w -> MO_AtomicRMW w AMO_Xor)
+    , allWidths "mul2_" (\w -> MO_S_Mul2 w)
+    , allWidths "mul2u_" (\w -> MO_U_Mul2 w)
    ]
  where
    allWidths
@@ -1255,14 +1303,22 @@ stmtMacros = listToUFM [
  ( fsLit "LOAD_THREAD_STATE",     \[] -> emitLoadThreadState ),
  ( fsLit "SAVE_THREAD_STATE",     \[] -> emitSaveThreadState ),

-  ( fsLit "SAVE_REGS",             \[] -> emitSaveRegs ),
-  ( fsLit "RESTORE_REGS",          \[] -> emitRestoreRegs ),
+  ( fsLit "SAVE_GP_ARG_REGS",         \[] -> emitSaveRegs GP_ARG_REGS ),
+  ( fsLit "RESTORE_GP_ARG_REGS",      \[] -> emitRestoreRegs GP_ARG_REGS ),
+  ( fsLit "SAVE_SCALAR_ARG_REGS",     \[] -> emitSaveRegs SCALAR_ARG_REGS ),
+  ( fsLit "RESTORE_SCALAR_ARG_REGS",  \[] -> emitRestoreRegs SCALAR_ARG_REGS ),
+  ( fsLit "SAVE_V16_ARG_REGS",        \[] -> emitSaveRegs V16_ARG_REGS ),
+  ( fsLit "RESTORE_V16_ARG_REGS",     \[] -> emitRestoreRegs V16_ARG_REGS ),
+  ( fsLit "SAVE_V32_ARG_REGS",        \[] -> emitSaveRegs V32_ARG_REGS ),
+  ( fsLit "RESTORE_V32_ARG_REGS",     \[] -> emitRestoreRegs V32_ARG_REGS ),
+  ( fsLit "SAVE_V64_ARG_REGS",         \[] -> emitSaveRegs V64_ARG_REGS ),
+  ( fsLit "RESTORE_V64_ARG_REGS",      \[] -> emitRestoreRegs V64_ARG_REGS ),

-  ( fsLit "PUSH_ARG_REGS",         \[live_regs] -> emitPushArgRegs live_regs ),
-  ( fsLit "POP_ARG_REGS",          \[live_regs] -> emitPopArgRegs live_regs ),
+  ( fsLit "PUSH_SCALAR_ARG_REGS",     \[live_regs] -> emitPushArgRegs SCALAR_ARG_REGS live_regs ),
+  ( fsLit "POP_SCALAR_ARG_REGS",      \[live_regs] -> emitPopArgRegs SCALAR_ARG_REGS live_regs ),

  ( fsLit "LDV_ENTER",             \[e] -> ldvEnter e ),
-  ( fsLit "LDV_RECORD_CREATE",     \[e] -> ldvRecordCreate e ),
+  ( fsLit "PROF_HEADER_CREATE",     \[e] -> profHeaderCreate e ),

  ( fsLit "PUSH_UPD_FRAME",        \[sp,e] -> emitPushUpdateFrame sp e ),
  ( fsLit "SET_HDR",               \[ptr,info,ccs] ->
@@ -1339,11 +1395,10 @@ foreignCall conv_string results_code expr_code args_code safety ret
          expr <- expr_code
          args <- sequence args_code
          let
-                  expr' = adjCallTarget platform conv expr args
                  (arg_exprs, arg_hints) = unzip args
                  (res_regs,  res_hints) = unzip results
                  fc = ForeignConvention conv arg_hints res_hints ret
-                  target = ForeignTarget expr' fc
+                  target = ForeignTarget expr fc
          _ <- code $ emitForeignCall safety res_regs target arg_exprs
          return ()

@@ -1361,7 +1416,7 @@ mkReturnSimple profile actuals updfr_off =
  where e = entryCode platform (cmmLoadGCWord platform (CmmStackSlot Old updfr_off))
        platform = profilePlatform profile

-doRawJump :: CmmParse CmmExpr -> [GlobalReg] -> CmmParse ()
+doRawJump :: CmmParse CmmExpr -> [GlobalRegUse] -> CmmParse ()
 doRawJump expr_code vols = do
  profile <- getProfile
  expr <- expr_code
@@ -1388,18 +1443,6 @@ doCall expr_code res_code args_code = do
  c <- code $ mkCall expr (NativeNodeCall,NativeReturn) ress args updfr_off []
  emit c

-adjCallTarget :: Platform -> CCallConv -> CmmExpr -> [(CmmExpr, ForeignHint) ]
-              -> CmmExpr
-- On Windows, we have to add the '@N' suffix to the label when making
-- a call with the stdcall calling convention.
-adjCallTarget platform StdCallConv (CmmLit (CmmLabel lbl)) args
- | platformOS platform == OSMinGW32
-  = CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
-  where size (e, _) = max (platformWordSizeInBytes platform) (widthInBytes (typeWidth (cmmExprType platform e)))
-                 -- c.f. CgForeignCall.emitForeignCall
-adjCallTarget _ _ expr _
-  = expr
-
 primCall
        :: [CmmParse (CmmFormal, ForeignHint)]
        -> FastString
@@ -1571,7 +1614,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
@@ -1591,11 +1634,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

--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
-{-# LANGUAGE BangPatterns #-}

 module GHC.Cmm.Pipeline (
  cmmPipeline
@@ -12,7 +11,7 @@ import GHC.Cmm
 import GHC.Cmm.Config
 import GHC.Cmm.ContFlowOpt
 import GHC.Cmm.CommonBlockElim
-import GHC.Cmm.Dataflow.Collections
+import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.Info.Build
 import GHC.Cmm.Lint
 import GHC.Cmm.LayoutStack
@@ -22,15 +21,17 @@ import GHC.Cmm.Switch.Implement
 import GHC.Cmm.ThreadSanitizer

 import GHC.Types.Unique.Supply
+import GHC.Types.Unique.DSM

 import GHC.Utils.Error
 import GHC.Utils.Logger
 import GHC.Utils.Outputable
-import GHC.Utils.Misc ( partitionWithM )
+import GHC.Utils.Misc ( partitionWith )

 import GHC.Platform

 import Control.Monad
+import GHC.Utils.Monad (mapAccumLM)

 -----------------------------------------------------------------------------
 -- | Top level driver for C-- pipeline
@@ -44,18 +45,19 @@ cmmPipeline
 -> CmmConfig
 -> ModuleSRTInfo        -- Info about SRTs generated so far
 -> CmmGroup             -- Input C-- with Procedures
- -> IO (ModuleSRTInfo, CmmGroupSRTs) -- Output CPS transformed C--
+ -> DUniqSupply
+ -> IO ((ModuleSRTInfo, CmmGroupSRTs), DUniqSupply) -- 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 prog dus0 = do
+  let forceRes ((info, group), us) = 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_
+     (dus1, prog')  <- {-# SCC "tops" #-} mapAccumLM (cpsTop logger platform cmm_config) dus0 prog
+     let (procs, data_) = partitionWith id prog'
+     (srtInfo, dus, cmms) <- {-# SCC "doSRTs" #-} doSRTs cmm_config srtInfo dus1 procs data_
     dumpWith logger Opt_D_dump_cmm_cps "Post CPS Cmm" FormatCMM (pdoc platform cmms)

-     return (srtInfo, cmms)
-
+     return ((srtInfo, cmms), dus)

 -- | The Cmm pipeline for a single 'CmmDecl'. Returns:
 --
@@ -65,9 +67,10 @@ cmmPipeline logger cmm_config srtInfo prog = do
 --     [SRTs].
 --
 --   - in the case of a `CmmData`, the unmodified 'CmmDecl' and a 'CAFSet' containing
-cpsTop :: Logger -> Platform -> CmmConfig -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDataDecl))
-cpsTop _logger platform _ (CmmData section statics) = return (Right (cafAnalData platform statics, CmmData section statics))
-cpsTop logger platform cfg proc =
+cpsTop :: Logger -> Platform -> CmmConfig -> DUniqSupply -> CmmDecl -> IO (DUniqSupply, Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDataDecl))
+cpsTop _logger platform _ dus (CmmData section statics) =
+  return (dus, Right (cafAnalData platform statics, CmmData section statics))
+cpsTop logger platform cfg dus proc =
    do
      ----------- Control-flow optimisations ----------------------------------

@@ -77,7 +80,7 @@ cpsTop logger platform cfg 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
@@ -91,16 +94,22 @@ cpsTop logger platform cfg proc =
      -- elimCommonBlocks

      ----------- Implement switches ------------------------------------------
-      g <- if cmmDoCmmSwitchPlans cfg
+      (g, dus) <- if cmmDoCmmSwitchPlans cfg
             then {-# SCC "createSwitchPlans" #-}
-                  runUniqSM $ cmmImplementSwitchPlans platform g
-             else pure g
+                  pure $ runUniqueDSM dus $ cmmImplementSwitchPlans platform g
+             else pure (g, dus)
      dump Opt_D_dump_cmm_switch "Post switch plan" g

      ----------- ThreadSanitizer instrumentation -----------------------------
      g <- {-# SCC "annotateTSAN" #-}
          if cmmOptThreadSanitizer cfg
-          then runUniqSM $ annotateTSAN platform g
+          then do
+             -- TODO(#25273): Use the deterministic UniqDSM (ie `runUniqueDSM`) instead
+             -- of UniqSM (see `initUs_`) to guarantee deterministic objects
+             -- when doing thread sanitization.
+            us <- mkSplitUniqSupply 'u'
+            return $ initUs_ us $
+              annotateTSAN platform g
          else return g
      dump Opt_D_dump_cmm_thread_sanitizer "ThreadSanitizer instrumentation" g

@@ -108,23 +117,23 @@ cpsTop logger platform cfg proc =
      let
        call_pps :: ProcPointSet -- LabelMap
        call_pps = {-# SCC "callProcPoints" #-} callProcPoints g
-      proc_points <-
+      (proc_points, dus) <-
         if splitting_proc_points
            then do
-              pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $
-                 minimalProcPointSet platform call_pps g
+              let (pp, dus') = {-# SCC "minimalProcPointSet" #-} runUniqueDSM dus $
+                    minimalProcPointSet platform call_pps g
              dumpWith logger Opt_D_dump_cmm_proc "Proc points"
                    FormatCMM (pdoc platform l $$ ppr pp $$ pdoc platform g)
-              return pp
+              return (pp, dus')
            else
-              return call_pps
+              return (call_pps, dus)

      ----------- Layout the stack and manifest Sp ----------------------------
-      (g, stackmaps) <-
-           {-# SCC "layoutStack" #-}
-           if do_layout
-              then runUniqSM $ cmmLayoutStack cfg proc_points entry_off g
-              else return (g, mapEmpty)
+      ((g, stackmaps), dus) <- pure $
+         {-# SCC "layoutStack" #-}
+         if do_layout
+            then runUniqueDSM dus $ cmmLayoutStack cfg proc_points entry_off g
+            else ((g, mapEmpty), dus)
      dump Opt_D_dump_cmm_sp "Layout Stack" g

      ----------- Sink and inline assignments  --------------------------------
@@ -136,21 +145,21 @@ cpsTop logger platform cfg proc =
      let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g
      dumpWith logger Opt_D_dump_cmm_caf "CAFEnv" FormatText (pdoc platform cafEnv)

-      g <- if splitting_proc_points
+      (g, dus) <- if splitting_proc_points
           then do
             ------------- Split into separate procedures -----------------------
             let pp_map = {-# SCC "procPointAnalysis" #-}
                          procPointAnalysis proc_points g
             dumpWith logger Opt_D_dump_cmm_procmap "procpoint map"
                FormatCMM (ppr pp_map)
-             g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
+             (g, dus) <- {-# SCC "splitAtProcPoints" #-} pure $ runUniqueDSM dus $
                  splitAtProcPoints platform l call_pps proc_points pp_map
                                    (CmmProc h l v g)
             dumps Opt_D_dump_cmm_split "Post splitting" g
-             return g
+             return (g, dus)
           else
             -- attach info tables to return points
-             return $ [attachContInfoTables call_pps (CmmProc h l v g)]
+             return ([attachContInfoTables call_pps (CmmProc h l v g)], dus)

      ------------- Populate info tables with stack info -----------------
      g <- {-# SCC "setInfoTableStackMap" #-}
@@ -164,9 +173,9 @@ cpsTop logger platform cfg 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 (Left (cafEnv, g))
+      return (dus, Left (cafEnv, g))

  where dump = dumpGraph logger platform (cmmDoLinting cfg)

@@ -350,12 +359,6 @@ generator later.

 -}

-runUniqSM :: UniqSM a -> IO a
-runUniqSM m = do
-  us <- mkSplitUniqSupply 'u'
-  return (initUs_ us m)
-
-
 dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO ()
 dumpGraph logger platform do_linting flag name g = do
  when do_linting $ do_lint g

--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE GADTs #-}

@@ -25,9 +24,8 @@ import Control.Monad
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Platform
-import GHC.Types.Unique.Supply
+import GHC.Types.Unique.DSM
 import GHC.Cmm.Dataflow.Block
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
@@ -187,14 +185,14 @@ callProcPoints g = foldlGraphBlocks add (setSingleton (g_entry g)) g
                      _ -> set

 minimalProcPointSet :: Platform -> ProcPointSet -> CmmGraph
-                    -> UniqSM ProcPointSet
+                    -> UniqDSM ProcPointSet
 -- Given the set of successors of calls (which must be proc-points)
 -- figure out the minimal set of necessary proc-points
 minimalProcPointSet platform callProcPoints g
  = extendPPSet platform g (revPostorder g) callProcPoints

 extendPPSet
-    :: Platform -> CmmGraph -> [CmmBlock] -> ProcPointSet -> UniqSM ProcPointSet
+    :: Platform -> CmmGraph -> [CmmBlock] -> ProcPointSet -> UniqDSM ProcPointSet
 extendPPSet platform g blocks procPoints =
    let env = procPointAnalysis procPoints g
        add pps block = let id = entryLabel block
@@ -238,7 +236,7 @@ extendPPSet platform g blocks procPoints =
 -- ToDo: use the _ret naming convention that the old code generator
 -- used. -- EZY
 splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl
-                  -> UniqSM [CmmDecl]
+                  -> UniqDSM [CmmDecl]
 splitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]
 splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
  -- Build a map from procpoints to the blocks they reach
@@ -264,8 +262,8 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do


  let liveness = cmmGlobalLiveness platform g
-  let ppLiveness pp = filter isArgReg $ regSetToList $
-                        expectJust "ppLiveness" $ mapLookup pp liveness
+  let ppLiveness pp = filter (isArgReg . globalRegUse_reg) $ regSetToList $
+                        expectJust $ mapLookup pp liveness
  graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g

  -- Build a map from proc point BlockId to pairs of:
@@ -288,9 +286,9 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
  -- and replace branches to procpoints with branches to the jump-off blocks
  let add_jump_block :: (LabelMap Label, [CmmBlock])
                     -> (Label, CLabel)
-                     -> UniqSM (LabelMap Label, [CmmBlock])
+                     -> UniqDSM (LabelMap Label, [CmmBlock])
      add_jump_block (env, bs) (pp, l) = do
-        bid <- liftM mkBlockId getUniqueM
+        bid <- liftM mkBlockId getUniqueDSM
        let b    = blockJoin (CmmEntry bid GlobalScope) emptyBlock jump
            live = ppLiveness pp
            jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0
@@ -319,7 +317,7 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
          CmmSwitch _ ids         -> foldr add_if_pp rst $ switchTargetsToList ids
          _                       -> rst

-  let add_jumps :: LabelMap CmmGraph -> (Label, LabelMap CmmBlock) -> UniqSM (LabelMap CmmGraph)
+  let add_jumps :: LabelMap CmmGraph -> (Label, LabelMap CmmBlock) -> UniqDSM (LabelMap CmmGraph)
      add_jumps newGraphEnv (ppId, blockEnv) = do
        -- find which procpoints we currently branch to
        let needed_jumps = mapFoldr add_if_branch_to_pp [] blockEnv
@@ -327,7 +325,7 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
        (jumpEnv, jumpBlocks) <-
           foldM add_jump_block (mapEmpty, []) needed_jumps
            -- update the entry block
-        let b = expectJust "block in env" $ mapLookup ppId blockEnv
+        let b = expectJust $ mapLookup ppId blockEnv
            blockEnv' = mapInsert ppId b blockEnv
            -- replace branches to procpoints with branches to jumps
            blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv'
@@ -345,7 +343,7 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
                               stack_info = stack_info})
                     top_l live g'
          | otherwise
-          = case expectJust "pp label" $ mapLookup bid procLabels of
+          = case expectJust $ mapLookup bid procLabels of
              (lbl, Just info_lbl)
                 -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
                                     , stack_info=stack_info})
@@ -379,8 +377,8 @@ splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
          foldl' add_block_num (0::Int, mapEmpty :: LabelMap Int)
                (revPostorder g)
  let sort_fn (bid, _) (bid', _) =
-        compare (expectJust "block_order" $ mapLookup bid  block_order)
-                (expectJust "block_order" $ mapLookup bid' block_order)
+        compare (expectJust $ mapLookup bid  block_order)
+                (expectJust $ mapLookup bid' block_order)

  return $ map to_proc $ sortBy sort_fn $ mapToList graphEnv


--- a/compiler/GHC/Cmm/Reducibility.hs
+++ b/compiler/GHC/Cmm/Reducibility.hs
@@ -40,7 +40,6 @@ import qualified Data.Sequence as Seq
 import GHC.Cmm
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dominators
 import GHC.Cmm.Dataflow.Graph hiding (addBlock)
@@ -48,7 +47,7 @@ import GHC.Cmm.Dataflow.Label
 import GHC.Data.Graph.Collapse
 import GHC.Data.Graph.Inductive.Graph
 import GHC.Data.Graph.Inductive.PatriciaTree
-import GHC.Types.Unique.Supply
+import GHC.Types.Unique.DSM
 import GHC.Utils.Panic

 -- | Represents the result of a reducibility analysis.
@@ -82,7 +81,7 @@ reducibility gwd =
 -- control-flow graph.

 asReducible :: GraphWithDominators CmmNode
-            -> UniqSM (GraphWithDominators CmmNode)
+            -> UniqDSM (GraphWithDominators CmmNode)
 asReducible gwd = case reducibility gwd of
                    Reducible -> return gwd
                    Irreducible -> assertReducible <$> nodeSplit gwd
@@ -98,7 +97,7 @@ assertReducible gwd = case reducibility gwd of
 -- irreducible.

 nodeSplit :: GraphWithDominators CmmNode
-          -> UniqSM (GraphWithDominators CmmNode)
+          -> UniqDSM (GraphWithDominators CmmNode)
 nodeSplit gwd =
    graphWithDominators <$> inflate (g_entry g) <$> runNullCollapse collapsed
  where g = gwd_graph gwd
@@ -182,7 +181,7 @@ instance PureSupernode CmmSuper where
  mapLabels = changeLabels

 instance Supernode CmmSuper NullCollapseViz where
-  freshen s = liftUniqSM $ relabel s
+  freshen s = liftUniqDSM $ relabel s


 -- | Return all labels defined within a supernode.
@@ -213,11 +212,11 @@ changeBlockLabels f block = blockJoin entry' middle exit'
 -- | Within the given supernode, replace every defined label (and all
 -- of its uses) with a fresh label.

-relabel :: CmmSuper -> UniqSM CmmSuper
+relabel :: CmmSuper -> UniqDSM CmmSuper
 relabel node = do
     finite_map <- foldM addPair mapEmpty $ definedLabels node
     return $ changeLabels (labelChanger finite_map) node
-  where addPair :: LabelMap Label -> Label -> UniqSM (LabelMap Label)
+  where addPair :: LabelMap Label -> Label -> UniqDSM (LabelMap Label)
        addPair map old = do new <- newBlockId
                             return $ mapInsert old new map
        labelChanger :: LabelMap Label -> (Label -> Label)

--- a/compiler/GHC/Cmm/Reg.hs
+++ b/compiler/GHC/Cmm/Reg.hs
@@ -16,6 +16,8 @@ module GHC.Cmm.Reg
    , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
    , node, baseReg
    , GlobalRegUse(..), pprGlobalRegUse
+
+    , GlobalArgRegs(..)
    ) where

 import GHC.Prelude
@@ -61,14 +63,14 @@ register are less easily stated. Some examples are:
 -- See Note [GlobalReg vs GlobalRegUse] for more information.
 data GlobalRegUse
  = GlobalRegUse
-    { globalRegUseGlobalReg :: !GlobalReg
+    { globalRegUse_reg  :: !GlobalReg
      -- ^ The underlying 'GlobalReg'
-    , globalRegUseType      :: !CmmType
+    , globalRegUse_type :: !CmmType
      -- ^ The 'CmmType' at which we are using the 'GlobalReg'.
      --
      -- Its width must be less than the width of the 'GlobalReg':
      --
-      -- > typeWidth ty <= typeWidth (globalRegSpillType reg)
+      -- > typeWidth ty <= typeWidth (globalRegSpillType platform reg)
    }
  deriving Show

@@ -101,7 +103,7 @@ pprReg r

 cmmRegType :: CmmReg -> CmmType
 cmmRegType (CmmLocal  reg) = localRegType reg
-cmmRegType (CmmGlobal reg) = globalRegUseType reg
+cmmRegType (CmmGlobal reg) = globalRegUse_type reg

 cmmRegWidth :: CmmReg -> Width
 cmmRegWidth = typeWidth . cmmRegType
@@ -202,6 +204,13 @@ data GlobalReg
  | LongReg             -- long int registers (64-bit, really)
        {-# UNPACK #-} !Int     -- its number

+  -- I think we should redesign 'GlobalReg', for example instead of
+  -- FloatReg/DoubleReg/XmmReg/YmmReg/ZmmReg we could have a single VecReg
+  -- which also stores the type we are storing in it.
+  --
+  -- We might then be able to get rid of GlobalRegUse, as the type information
+  -- would already be contained in a 'GlobalReg'.
+
  | XmmReg                      -- 128-bit SIMD vector register
        {-# UNPACK #-} !Int     -- its number

@@ -212,39 +221,40 @@ data GlobalReg
        {-# UNPACK #-} !Int     -- its number

  -- STG registers
-  | Sp                  -- Stack ptr; points to last occupied stack location.
-  | SpLim               -- Stack limit
-  | Hp                  -- Heap ptr; points to last occupied heap location.
-  | HpLim               -- Heap limit register
-  | CCCS                -- Current cost-centre stack
-  | CurrentTSO          -- pointer to current thread's TSO
-  | CurrentNursery      -- pointer to allocation area
-  | HpAlloc             -- allocation count for heap check failure
+  | Sp                  -- ^ Stack ptr; points to last occupied stack location.
+  | SpLim               -- ^ Stack limit
+  | Hp                  -- ^ Heap ptr; points to last occupied heap location.
+  | HpLim               -- ^ Heap limit register
+  | CCCS                -- ^ Current cost-centre stack
+  | CurrentTSO          -- ^ pointer to current thread's TSO
+  | CurrentNursery      -- ^ pointer to allocation area
+  | HpAlloc             -- ^ allocation count for heap check failure

                -- We keep the address of some commonly-called
                -- functions in the register table, to keep code
                -- size down:
-  | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info
-  | GCEnter1            -- stg_gc_enter_1
-  | GCFun               -- stg_gc_fun
+  | EagerBlackholeInfo  -- ^ address of stg_EAGER_BLACKHOLE_info
+  | GCEnter1            -- ^ address of stg_gc_enter_1
+  | GCFun               -- ^ address of stg_gc_fun

-  -- Base offset for the register table, used for accessing registers
+  -- | Base offset for the register table, used for accessing registers
  -- which do not have real registers assigned to them.  This register
  -- will only appear after we have expanded GlobalReg into memory accesses
  -- (where necessary) in the native code generator.
  | BaseReg

-  -- The register used by the platform for the C stack pointer. This is
+  -- | The register used by the platform for the C stack pointer. This is
  -- a break in the STG abstraction used exclusively to setup stack unwinding
  -- information.
  | MachSp

-  -- The is a dummy register used to indicate to the stack unwinder where
+  -- | A dummy register used to indicate to the stack unwinder where
  -- a routine would return to.
  | UnwindReturnReg

-  -- Base Register for PIC (position-independent code) calculations
-  -- Only used inside the native code generator. It's exact meaning differs
+  -- | Base Register for PIC (position-independent code) calculations.
+  --
+  -- Only used inside the native code generator. Its exact meaning differs
  -- from platform to platform (see module PositionIndependentCode).
  | PicBaseReg

@@ -331,3 +341,24 @@ isArgReg (XmmReg {})     = True
 isArgReg (YmmReg {})     = True
 isArgReg (ZmmReg {})     = True
 isArgReg _               = False
+
+-- --------------------------------------------------------------------------
+
+-- | Global registers used for argument passing.
+--
+-- See Note [realArgRegsCover] in GHC.Cmm.CallConv.
+data GlobalArgRegs
+  -- | General-purpose (integer) argument-passing registers.
+  = GP_ARG_REGS
+  -- | Scalar (integer & floating-point) argument-passing registers.
+  | SCALAR_ARG_REGS
+  -- | 16 byte vector argument-passing registers, together with
+  -- integer & floating-point argument-passing scalar registers.
+  | V16_ARG_REGS
+  -- | 32 byte vector argument-passing registers, together with
+  -- integer & floating-point argument-passing scalar registers.
+  | V32_ARG_REGS
+  -- | 64 byte vector argument-passing registers, together with
+  -- integer & floating-point argument-passing scalar registers.
+  | V64_ARG_REGS
+  deriving ( Show, Eq, Ord )
--- a/compiler/GHC/Cmm/Sink.hs
+++ b/compiler/GHC/Cmm/Sink.hs
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiWayIf #-}

 module GHC.Cmm.Sink (
     cmmSink
@@ -14,14 +15,12 @@ import GHC.Cmm.LRegSet
 import GHC.Cmm.Utils
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Label
-import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Graph
 import GHC.Platform.Regs

 import GHC.Platform
 import GHC.Types.Unique.FM

-import qualified GHC.Data.Word64Set as Word64Set
 import Data.List (partition)
 import Data.Maybe

@@ -175,7 +174,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
      -- Annotate the middle nodes with the registers live *after*
      -- the node.  This will help us decide whether we can inline
      -- an assignment in the current node or not.
-      live = Word64Set.unions (map getLive succs)
+      live = unionsLRegSet (map getLive succs)
      live_middle = gen_killL platform last live
      ann_middles = annotate platform live_middle (blockToList middle)

@@ -188,7 +187,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
      -- one predecessor), so identify the join points and the set
      -- of registers live in them.
      (joins, nonjoins) = partition (`mapMember` join_pts) succs
-      live_in_joins = Word64Set.unions (map getLive joins)
+      live_in_joins = unionsLRegSet (map getLive joins)

      -- We do not want to sink an assignment into multiple branches,
      -- so identify the set of registers live in multiple successors.
@@ -215,7 +214,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
            live_sets' | should_drop = live_sets
                       | otherwise   = map upd live_sets

-            upd set | r `elemLRegSet` set = set `Word64Set.union` live_rhs
+            upd set | r `elemLRegSet` set = set `unionLRegSet` live_rhs
                    | otherwise          = set

            live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs
@@ -520,7 +519,7 @@ tryToInline platform liveAfter node assigs =

 {- Note [Keeping assignments mentioned in skipped RHSs]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-    If we have to assignments: [z = y, y = e1] and we skip
+    If we have two assignments: [z = y, y = e1] and we skip
    z we *must* retain the assignment y = e1. This is because
    we might inline "z = y" into another node later on so we
    must ensure y is still defined at this point.
@@ -593,7 +592,7 @@ improveConditional other = other
 -- Now we can go ahead and inline x.
 --
 -- For now we do nothing, because this would require putting
-- everything inside UniqSM.
+-- everything inside UniqDSM.
 --
 -- One more variant of this (#7366):
 --
@@ -704,7 +703,7 @@ conflicts platform (r, rhs, addr) node
 globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
 globalRegistersConflict platform expr node =
   -- See Note [Inlining foldRegsDefd]
-   inline foldRegsDefd platform (\b r -> b || globalRegUsedIn platform r expr)
+   inline foldRegsDefd platform (\b r -> b || globalRegUsedIn platform (globalRegUse_reg r) expr)
                False node

 -- Returns True if node defines any local registers that are used in the

--- a/compiler/GHC/Cmm/Switch.hs
+++ b/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

--- a/compiler/GHC/Cmm/Switch/Implement.hs
+++ b/compiler/GHC/Cmm/Switch/Implement.hs
@@ -12,8 +12,8 @@ import GHC.Cmm.BlockId
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
-import GHC.Types.Unique.Supply
 import GHC.Utils.Monad (concatMapM)
+import GHC.Types.Unique.DSM

 --
 -- This module replaces Switch statements as generated by the Stg -> Cmm
@@ -31,14 +31,14 @@ import GHC.Utils.Monad (concatMapM)

 -- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for
 -- code generation.
-cmmImplementSwitchPlans :: Platform -> CmmGraph -> UniqSM CmmGraph
+cmmImplementSwitchPlans :: Platform -> CmmGraph -> UniqDSM CmmGraph
 cmmImplementSwitchPlans platform g =
    -- Switch generation done by backend (LLVM/C)
    do
    blocks' <- concatMapM (visitSwitches platform) (toBlockList g)
    return $ ofBlockList (g_entry g) blocks'

-visitSwitches :: Platform -> CmmBlock -> UniqSM [CmmBlock]
+visitSwitches :: Platform -> CmmBlock -> UniqDSM [CmmBlock]
 visitSwitches platform block
  | (entry@(CmmEntry _ scope), middle, CmmSwitch vanillaExpr ids) <- blockSplit block
  = do
@@ -69,15 +69,15 @@ visitSwitches platform block
 -- This happened in parts of the handwritten RTS Cmm code. See also #16933

 -- See Note [Floating switch expressions]
-floatSwitchExpr :: Platform -> CmmExpr -> UniqSM (Block CmmNode O O, CmmExpr)
+floatSwitchExpr :: Platform -> CmmExpr -> UniqDSM (Block CmmNode O O, CmmExpr)
 floatSwitchExpr _        reg@(CmmReg {})  = return (emptyBlock, reg)
 floatSwitchExpr platform expr             = do
-  (assign, expr') <- cmmMkAssign platform expr <$> getUniqueM
+  (assign, expr') <- cmmMkAssign platform expr <$> getUniqueDSM
  return (BMiddle assign, expr')


 -- Implementing a switch plan (returning a tail block)
-implementSwitchPlan :: Platform -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqSM (Block CmmNode O C, [CmmBlock])
+implementSwitchPlan :: Platform -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqDSM (Block CmmNode O C, [CmmBlock])
 implementSwitchPlan platform scope expr = go
  where
    width = typeWidth $ cmmExprType platform expr
@@ -111,7 +111,7 @@ implementSwitchPlan platform scope expr = go
      = return (l, [])
    go' p
      = do
-        bid <- mkBlockId `fmap` getUniqueM
+        bid <- mkBlockId `fmap` getUniqueDSM
        (last, newBlocks) <- go p
        let block = CmmEntry bid scope `blockJoinHead` last
        return (bid, block: newBlocks)
--- a/compiler/GHC/Cmm/ThreadSanitizer.hs
+++ b/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
@@ -84,6 +85,7 @@ annotateExpr :: Env -> CmmExpr -> Block CmmNode O O
 annotateExpr env expr =
    annotateLoads env (collectExprLoads expr)

+-- | A load mentioned in a 'CmmExpr'.
 data Load = Load CmmType AlignmentSpec CmmExpr

 annotateLoads :: Env -> [Load] -> Block CmmNode O O
@@ -102,6 +104,9 @@ collectExprLoads :: CmmExpr -> [Load]
 collectExprLoads (CmmLit _)           = []
 collectExprLoads (CmmLoad e ty align) = [Load ty align e]
 collectExprLoads (CmmReg _)           = []
+-- N.B. we don't bother telling TSAN about MO_RelaxedReads
+-- since doing so would be inconvenient and they by
+-- definition can neither race nor introduce ordering.
 collectExprLoads (CmmMachOp _op args) = foldMap collectExprLoads args
 collectExprLoads (CmmStackSlot _ _)   = []
 collectExprLoads (CmmRegOff _ _)      = []
@@ -180,7 +185,7 @@ saveRestoreCallerRegs us platform =
    restore = blockFromList restore_nodes

 -- | Mirrors __tsan_memory_order
-- <https://github.com/llvm-mirror/compiler-rt/blob/master/include/sanitizer/tsan_interface_atomic.h#L32>
+-- <https://github.com/llvm/llvm-project/blob/main/compiler-rt/include/sanitizer/tsan_interface_atomic.h#L34>
 memoryOrderToTsanMemoryOrder :: Env -> MemoryOrdering -> CmmExpr
 memoryOrderToTsanMemoryOrder env mord =
    mkIntExpr (platform env) n
@@ -199,13 +204,14 @@ tsanTarget fn formals args =
    ForeignTarget (CmmLit (CmmLabel lbl)) conv
  where
    conv = ForeignConvention CCallConv args formals CmmMayReturn
-    lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction
+    lbl = mkForeignLabel fn ForeignLabelInExternalPackage IsFunction

 tsanStore :: Env
          -> CmmType -> CmmExpr
          -> Block CmmNode O O
-tsanStore env ty addr =
-    mkUnsafeCall env ftarget [] [addr]
+tsanStore env ty addr
+  | typeWidth ty < W128 = mkUnsafeCall env ftarget [] [addr]
+  | otherwise           = emptyBlock
  where
    ftarget = tsanTarget fn [] [AddrHint]
    w = widthInBytes (typeWidth ty)
@@ -214,8 +220,9 @@ tsanStore env ty addr =
 tsanLoad :: Env
         -> AlignmentSpec -> CmmType -> CmmExpr
         -> Block CmmNode O O
-tsanLoad env align ty addr =
-    mkUnsafeCall env ftarget [] [addr]
+tsanLoad env align ty addr
+  | typeWidth ty < W128  = mkUnsafeCall env ftarget [] [addr]
+  | otherwise            = emptyBlock
  where
    ftarget = tsanTarget fn [] [AddrHint]
    w = widthInBytes (typeWidth ty)
@@ -290,4 +297,3 @@ tsanAtomicRMW env mord op w addr val dest =
           AMO_Or   -> "fetch_or"
           AMO_Xor  -> "fetch_xor"
    fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_" ++ op'
-
No results found