Put CFG weights into their own module (#17957)

It avoids having to query DynFlags to get them

11 files changed, 186 insertions, 179 deletions

diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 84c7999f69..efb5f80802 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -34,7 +34,7 @@ import GHC.Runtime.Heap.Layout
 import GHC.Types.Unique.Supply
 import GHC.Types.CostCentre
 import GHC.StgToCmm.Heap
-import GHC.CmmToAsm.Monad
+import GHC.CmmToAsm
 
 import Control.Monad
 import Data.Map.Strict (Map)
@@ -933,7 +933,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
   topSRT <- get
 
   let
-    config = initConfig dflags
+    config = initNCGConfig dflags
     profile = targetProfile dflags
     platform = profilePlatform profile
     srtMap = moduleSRTMap topSRT
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 2cd982288d..c2b32574ba 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -72,6 +72,7 @@ module GHC.CmmToAsm
    -- cmmNativeGen emits
    , cmmNativeGen
    , NcgImpl(..)
+   , initNCGConfig
    )
 where
 
@@ -147,7 +148,7 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS
               -> Stream IO RawCmmGroup a
               -> IO a
 nativeCodeGen dflags this_mod modLoc h us cmms
- = let config   = initConfig dflags
+ = let config   = initNCGConfig dflags
        platform = ncgPlatform config
        nCG' :: ( Outputable statics, Outputable jumpDest, Instruction instr)
             => NcgImpl statics instr jumpDest -> IO a
@@ -442,6 +443,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
  = do
         let config   = ncgConfig ncgImpl
         let platform = ncgPlatform config
+        let weights  = ncgCfgWeights config
 
         let proc_name = case cmm of
                 (CmmProc _ entry_label _ _) -> ppr entry_label
@@ -462,12 +464,12 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
                 (pprCmmGroup [opt_cmm])
 
         let cmmCfg = {-# SCC "getCFG" #-}
-                     getCfgProc (cfgWeightInfo dflags) opt_cmm
+                     getCfgProc weights opt_cmm
 
         -- generate native code from cmm
         let ((native, lastMinuteImports, fileIds', nativeCfgWeights), usGen) =
                 {-# SCC "genMachCode" #-}
-                initUs us $ genMachCode dflags this_mod modLoc
+                initUs us $ genMachCode config this_mod modLoc
                                         (cmmTopCodeGen ncgImpl)
                                         fileIds dbgMap opt_cmm cmmCfg
 
@@ -594,11 +596,11 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
             cfgRegAllocUpdates = (concatMap Linear.ra_fixupList raStats)
 
         let cfgWithFixupBlks =
-                (\cfg -> addNodesBetween dflags cfg cfgRegAllocUpdates) <$> livenessCfg
+                (\cfg -> addNodesBetween weights cfg cfgRegAllocUpdates) <$> livenessCfg
 
         -- Insert stack update blocks
         let postRegCFG =
-                pure (foldl' (\m (from,to) -> addImmediateSuccessor dflags from to m ))
+                pure (foldl' (\m (from,to) -> addImmediateSuccessor weights from to m ))
                      <*> cfgWithFixupBlks
                      <*> pure stack_updt_blks
 
@@ -620,7 +622,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
 
         let optimizedCFG :: Maybe CFG
             optimizedCFG =
-                optimizeCFG (gopt Opt_CmmStaticPred dflags) (cfgWeightInfo dflags) cmm <$!> postShortCFG
+                optimizeCFG (gopt Opt_CmmStaticPred dflags) weights cmm <$!> postShortCFG
 
         maybeDumpCfg dflags optimizedCFG "CFG Weights - Final" proc_name
 
@@ -768,7 +770,7 @@ makeImportsDoc dflags imports
              else Outputable.empty)
 
  where
-        config   = initConfig dflags
+        config   = initNCGConfig dflags
         platform = ncgPlatform config
 
         -- Generate "symbol stubs" for all external symbols that might
@@ -904,7 +906,7 @@ apply_mapping ncgImpl ufm (CmmProc info lbl live (ListGraph blocks))
 -- Unique supply breaks abstraction.  Is that bad?
 
 genMachCode
-        :: DynFlags
+        :: NCGConfig
         -> Module -> ModLocation
         -> (RawCmmDecl -> NatM [NatCmmDecl statics instr])
         -> DwarfFiles
@@ -918,9 +920,9 @@ genMachCode
                 , CFG
                 )
 
-genMachCode dflags this_mod modLoc cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg
+genMachCode config this_mod modLoc cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg
   = do  { initial_us <- getUniqueSupplyM
-        ; let initial_st           = mkNatM_State initial_us 0 dflags this_mod
+        ; let initial_st           = mkNatM_State initial_us 0 config this_mod
                                                   modLoc fileIds dbgMap cmm_cfg
               (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
               final_delta          = natm_delta final_st
@@ -1134,3 +1136,48 @@ cmmExprNative referenceKind expr = do
 
         other
            -> return other
+
+-- | Initialize the native code generator configuration from the DynFlags
+initNCGConfig :: DynFlags -> NCGConfig
+initNCGConfig dflags = NCGConfig
+   { ncgPlatform              = targetPlatform dflags
+   , ncgProcAlignment         = cmmProcAlignment dflags
+   , ncgDebugLevel            = debugLevel dflags
+   , ncgExternalDynamicRefs   = gopt Opt_ExternalDynamicRefs dflags
+   , ncgPIC                   = positionIndependent dflags
+   , ncgInlineThresholdMemcpy = fromIntegral $ maxInlineMemcpyInsns dflags
+   , ncgInlineThresholdMemset = fromIntegral $ maxInlineMemsetInsns dflags
+   , ncgSplitSections         = gopt Opt_SplitSections dflags
+   , ncgRegsIterative         = gopt Opt_RegsIterative dflags
+   , ncgAsmLinting            = gopt Opt_DoAsmLinting dflags
+   , ncgCfgWeights            = cfgWeights dflags
+
+     -- With -O1 and greater, the cmmSink pass does constant-folding, so
+     -- we don't need to do it again in the native code generator.
+   , ncgDoConstantFolding     = optLevel dflags < 1
+
+   , ncgDumpRegAllocStages    = dopt Opt_D_dump_asm_regalloc_stages dflags
+   , ncgDumpAsmStats          = dopt Opt_D_dump_asm_stats dflags
+   , ncgDumpAsmConflicts      = dopt Opt_D_dump_asm_conflicts dflags
+   , ncgBmiVersion            = case platformArch (targetPlatform dflags) of
+                                 ArchX86_64 -> bmiVersion dflags
+                                 ArchX86    -> bmiVersion dflags
+                                 _          -> Nothing
+
+     -- We Assume  SSE1 and SSE2 operations are available on both
+     -- x86 and x86_64. Historically we didn't default to SSE2 and
+     -- SSE1 on x86, which results in defacto nondeterminism for how
+     -- rounding behaves in the associated x87 floating point instructions
+     -- because variations in the spill/fpu stack placement of arguments for
+     -- operations would change the precision and final result of what
+     -- would otherwise be the same expressions with respect to single or
+     -- double precision IEEE floating point computations.
+   , ncgSseVersion =
+      let v | sseVersion dflags < Just SSE2 = Just SSE2
+            | otherwise                     = sseVersion dflags
+      in case platformArch (targetPlatform dflags) of
+            ArchX86_64 -> v
+            ArchX86    -> v
+            _          -> Nothing
+   }
+
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index dd46393649..e054e488b6 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -62,6 +62,7 @@ import GHC.Data.Maybe
 
 import GHC.Types.Unique
 import qualified GHC.CmmToAsm.CFG.Dominators as Dom
+import GHC.CmmToAsm.CFG.Weight
 import Data.IntMap.Strict (IntMap)
 import Data.IntSet (IntSet)
 
@@ -79,7 +80,6 @@ import GHC.Utils.Panic
 --import GHC.Data.OrdList
 --import GHC.Cmm.DebugBlock.Trace
 import GHC.Cmm.Ppr () -- For Outputable instances
-import qualified GHC.Driver.Session as D
 
 import Data.List (sort, nub, partition)
 import Data.STRef.Strict
@@ -329,12 +329,11 @@ shortcutWeightMap cuts cfg =
 --             \                  \
 --              -> C    =>         -> C
 --
-addImmediateSuccessor :: D.DynFlags -> BlockId -> BlockId -> CFG -> CFG
-addImmediateSuccessor dflags node follower cfg
-    = updateEdges . addWeightEdge node follower uncondWeight $ cfg
+addImmediateSuccessor :: Weights -> BlockId -> BlockId -> CFG -> CFG
+addImmediateSuccessor weights node follower cfg
+    = updateEdges . addWeightEdge node follower weight $ cfg
     where
-        uncondWeight = fromIntegral . D.uncondWeight .
-                       D.cfgWeightInfo $ dflags
+        weight = fromIntegral (uncondWeight weights)
         targets = getSuccessorEdges cfg node
         successors = map fst targets :: [BlockId]
         updateEdges = addNewSuccs . remOldSuccs
@@ -509,13 +508,12 @@ mapWeights f cfg =
 -- these cases.
 -- We assign the old edge info to the edge A -> B and assign B -> C the
 -- weight of an unconditional jump.
-addNodesBetween :: D.DynFlags -> CFG -> [(BlockId,BlockId,BlockId)] -> CFG
-addNodesBetween dflags m updates =
+addNodesBetween :: Weights -> CFG -> [(BlockId,BlockId,BlockId)] -> CFG
+addNodesBetween weights m updates =
   foldl'  updateWeight m .
           weightUpdates $ updates
     where
-      weight = fromIntegral . D.uncondWeight .
-                D.cfgWeightInfo $ dflags
+      weight = fromIntegral (uncondWeight weights)
       -- We might add two blocks for different jumps along a single
       -- edge. So we end up with edges:   A -> B -> C   ,   A -> D -> C
       -- in this case after applying the first update the weight for A -> C
@@ -585,24 +583,24 @@ addNodesBetween dflags m updates =
 
 -}
 -- | Generate weights for a Cmm proc based on some simple heuristics.
-getCfgProc :: D.CfgWeights -> RawCmmDecl -> CFG
+getCfgProc :: Weights -> RawCmmDecl -> CFG
 getCfgProc _       (CmmData {}) = mapEmpty
 getCfgProc weights (CmmProc _info _lab _live graph) = getCfg weights graph
 
-getCfg :: D.CfgWeights -> CmmGraph -> CFG
+getCfg :: Weights -> CmmGraph -> CFG
 getCfg weights graph =
   foldl' insertEdge edgelessCfg $ concatMap getBlockEdges blocks
   where
-    D.CFGWeights
-            { D.uncondWeight = uncondWeight
-            , D.condBranchWeight = condBranchWeight
-            , D.switchWeight = switchWeight
-            , D.callWeight = callWeight
-            , D.likelyCondWeight = likelyCondWeight
-            , D.unlikelyCondWeight = unlikelyCondWeight
+    Weights
+            { uncondWeight = uncondWeight
+            , condBranchWeight = condBranchWeight
+            , switchWeight = switchWeight
+            , callWeight = callWeight
+            , likelyCondWeight = likelyCondWeight
+            , unlikelyCondWeight = unlikelyCondWeight
             --  Last two are used in other places
-            --, D.infoTablePenalty = infoTablePenalty
-            --, D.backEdgeBonus = backEdgeBonus
+            --, infoTablePenalty = infoTablePenalty
+            --, backEdgeBonus = backEdgeBonus
             } = weights
     -- Explicitly add all nodes to the cfg to ensure they are part of the
     -- CFG.
@@ -631,7 +629,7 @@ getCfg weights graph =
             mkEdge target weight = ((bid,target), mkEdgeInfo weight)
             branchInfo =
               foldRegsUsed
-                (panic "foldRegsDynFlags")
+                (panic "GHC.CmmToAsm.CFG.getCfg: foldRegsUsed")
                 (\info r -> if r == SpLim || r == HpLim || r == BaseReg
                     then HeapStackCheck else info)
                 NoInfo cond
@@ -671,7 +669,7 @@ findBackEdges root cfg =
     typedEdges =
       classifyEdges root getSuccs edges :: [((BlockId,BlockId),EdgeType)]
 
-optimizeCFG :: Bool -> D.CfgWeights -> RawCmmDecl -> CFG -> CFG
+optimizeCFG :: Bool -> Weights -> RawCmmDecl -> CFG -> CFG
 optimizeCFG _ _ (CmmData {}) cfg = cfg
 optimizeCFG doStaticPred weights proc@(CmmProc _info _lab _live graph) cfg =
   (if doStaticPred then staticPredCfg (g_entry graph) else id) $
@@ -682,7 +680,7 @@ optimizeCFG doStaticPred weights proc@(CmmProc _info _lab _live graph) cfg =
 -- performance.
 --
 -- Most importantly we penalize jumps across info tables.
-optHsPatterns :: D.CfgWeights -> RawCmmDecl -> CFG -> CFG
+optHsPatterns :: Weights -> RawCmmDecl -> CFG -> CFG
 optHsPatterns _ (CmmData {}) cfg = cfg
 optHsPatterns weights (CmmProc info _lab _live graph) cfg =
     {-# SCC optHsPatterns #-}
@@ -704,7 +702,7 @@ optHsPatterns weights (CmmProc info _lab _live graph) cfg =
               --Keep irrelevant edges irrelevant
               | weight <= 0 = 0
               | otherwise
-              = weight + fromIntegral (D.backEdgeBonus weights)
+              = weight + fromIntegral (backEdgeBonus weights)
         in  foldl'  (\cfg edge -> updateEdgeWeight update edge cfg)
                     cfg backedges
 
@@ -716,7 +714,7 @@ optHsPatterns weights (CmmProc info _lab _live graph) cfg =
         fupdate :: BlockId -> BlockId -> EdgeWeight -> EdgeWeight
         fupdate _ to weight
           | mapMember to info
-          = weight - (fromIntegral $ D.infoTablePenalty weights)
+          = weight - (fromIntegral $ infoTablePenalty weights)
           | otherwise = weight
 
     -- | If a block has two successors, favour the one with fewer
diff --git a/compiler/GHC/CmmToAsm/CFG/Weight.hs b/compiler/GHC/CmmToAsm/CFG/Weight.hs
new file mode 100644
index 0000000000..482e857b5a
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/CFG/Weight.hs
@@ -0,0 +1,78 @@
+module GHC.CmmToAsm.CFG.Weight
+   ( Weights (..)
+   , defaultWeights
+   , parseWeights
+   )
+where
+
+import GHC.Prelude
+import GHC.Utils.Panic
+
+-- | Edge weights to use when generating a CFG from CMM
+data Weights = Weights
+   { uncondWeight       :: Int
+   , condBranchWeight   :: Int
+   , switchWeight       :: Int
+   , callWeight         :: Int
+   , likelyCondWeight   :: Int
+   , unlikelyCondWeight :: Int
+   , infoTablePenalty   :: Int
+   , backEdgeBonus      :: Int
+   }
+
+-- | Default edge weights
+defaultWeights :: Weights
+defaultWeights = Weights
+   { uncondWeight       = 1000
+   , condBranchWeight   = 800
+   , switchWeight       = 1
+   , callWeight         = -10
+   , likelyCondWeight   = 900
+   , unlikelyCondWeight = 300
+   , infoTablePenalty   = 300
+   , backEdgeBonus      = 400
+   }
+
+parseWeights :: String -> Weights -> Weights
+parseWeights s oldWeights =
+        foldl' (\cfg (n,v) -> update n v cfg) oldWeights assignments
+    where
+        assignments = map assignment $ settings s
+        update "uncondWeight" n w =
+            w {uncondWeight = n}
+        update "condBranchWeight" n w =
+            w {condBranchWeight = n}
+        update "switchWeight" n w =
+            w {switchWeight = n}
+        update "callWeight" n w =
+            w {callWeight = n}
+        update "likelyCondWeight" n w =
+            w {likelyCondWeight = n}
+        update "unlikelyCondWeight" n w =
+            w {unlikelyCondWeight = n}
+        update "infoTablePenalty" n w =
+            w {infoTablePenalty = n}
+        update "backEdgeBonus" n w =
+            w {backEdgeBonus = n}
+        update other _ _
+            = panic $ other ++
+                      " is not a CFG weight parameter. " ++
+                      exampleString
+        settings s
+            | (s1,rest) <- break (== ',') s
+            , null rest
+            = [s1]
+            | (s1,rest) <- break (== ',') s
+            = s1 : settings (drop 1 rest)
+
+        assignment as
+            | (name, _:val) <- break (== '=') as
+            = (name,read val)
+            | otherwise
+            = panic $ "Invalid CFG weight parameters." ++ exampleString
+
+        exampleString = "Example parameters: uncondWeight=1000," ++
+            "condBranchWeight=800,switchWeight=0,callWeight=300" ++
+            ",likelyCondWeight=900,unlikelyCondWeight=300" ++
+            ",infoTablePenalty=300,backEdgeBonus=400"
+
diff --git a/compiler/GHC/CmmToAsm/Config.hs b/compiler/GHC/CmmToAsm/Config.hs
index e6b5489b9e..88cff6a3eb 100644
--- a/compiler/GHC/CmmToAsm/Config.hs
+++ b/compiler/GHC/CmmToAsm/Config.hs
@@ -10,6 +10,7 @@ where
 import GHC.Prelude
 import GHC.Platform
 import GHC.Cmm.Type (Width(..))
+import GHC.CmmToAsm.CFG.Weight
 
 -- | Native code generator configuration
 data NCGConfig = NCGConfig
@@ -29,6 +30,7 @@ data NCGConfig = NCGConfig
    , ncgDumpRegAllocStages    :: !Bool
    , ncgDumpAsmStats          :: !Bool
    , ncgDumpAsmConflicts      :: !Bool
+   , ncgCfgWeights            :: !Weights         -- ^ CFG edge weights
    }
 
 -- | Return Word size
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index 5a77e051cc..acde673c59 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -16,7 +16,6 @@ module GHC.CmmToAsm.Monad (
 
         NatM, -- instance Monad
         initNat,
-        initConfig,
         addImportNat,
         addNodeBetweenNat,
         addImmediateSuccessorNat,
@@ -34,7 +33,7 @@ module GHC.CmmToAsm.Monad (
         getNewRegPairNat,
         getPicBaseMaybeNat,
         getPicBaseNat,
-        getDynFlags,
+        getCfgWeights,
         getModLoc,
         getFileId,
         getDebugBlock,
@@ -64,7 +63,6 @@ import GHC.Data.FastString      ( FastString )
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
 import GHC.Types.Unique         ( Unique )
-import GHC.Driver.Session
 import GHC.Unit.Module
 
 import Control.Monad    ( ap )
@@ -72,6 +70,7 @@ import Control.Monad    ( ap )
 import GHC.Utils.Outputable (SDoc, ppr)
 import GHC.Utils.Panic      (pprPanic)
 import GHC.CmmToAsm.CFG
+import GHC.CmmToAsm.CFG.Weight
 
 data NcgImpl statics instr jumpDest = NcgImpl {
     ncgConfig                 :: !NCGConfig,
@@ -107,7 +106,6 @@ data NatM_State
                 natm_delta       :: Int,
                 natm_imports     :: [(CLabel)],
                 natm_pic         :: Maybe Reg,
-                natm_dflags      :: DynFlags,
                 natm_config      :: NCGConfig,
                 natm_this_module :: Module,
                 natm_modloc      :: ModLocation,
@@ -127,17 +125,16 @@ newtype NatM result = NatM (NatM_State -> (result, NatM_State))
 unNat :: NatM a -> NatM_State -> (a, NatM_State)
 unNat (NatM a) = a
 
-mkNatM_State :: UniqSupply -> Int -> DynFlags -> Module -> ModLocation ->
+mkNatM_State :: UniqSupply -> Int -> NCGConfig -> Module -> ModLocation ->
                 DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
-mkNatM_State us delta dflags this_mod
+mkNatM_State us delta config this_mod
         = \loc dwf dbg cfg ->
                 NatM_State
                         { natm_us = us
                         , natm_delta = delta
                         , natm_imports = []
                         , natm_pic = Nothing
-                        , natm_dflags = dflags
-                        , natm_config = initConfig dflags
+                        , natm_config = config
                         , natm_this_module = this_mod
                         , natm_modloc = loc
                         , natm_fileid = dwf
@@ -145,49 +142,6 @@ mkNatM_State us delta dflags this_mod
                         , natm_cfg = cfg
                         }
 
--- | Initialize the native code generator configuration from the DynFlags
-initConfig :: DynFlags -> NCGConfig
-initConfig dflags = NCGConfig
-   { ncgPlatform              = targetPlatform dflags
-   , ncgProcAlignment         = cmmProcAlignment dflags
-   , ncgDebugLevel            = debugLevel dflags
-   , ncgExternalDynamicRefs   = gopt Opt_ExternalDynamicRefs dflags
-   , ncgPIC                   = positionIndependent dflags
-   , ncgInlineThresholdMemcpy = fromIntegral $ maxInlineMemcpyInsns dflags
-   , ncgInlineThresholdMemset = fromIntegral $ maxInlineMemsetInsns dflags
-   , ncgSplitSections         = gopt Opt_SplitSections dflags
-   , ncgRegsIterative         = gopt Opt_RegsIterative dflags
-   , ncgAsmLinting            = gopt Opt_DoAsmLinting dflags
-
-     -- With -O1 and greater, the cmmSink pass does constant-folding, so
-     -- we don't need to do it again in the native code generator.
-   , ncgDoConstantFolding     = optLevel dflags < 1
-
-   , ncgDumpRegAllocStages    = dopt Opt_D_dump_asm_regalloc_stages dflags
-   , ncgDumpAsmStats          = dopt Opt_D_dump_asm_stats dflags
-   , ncgDumpAsmConflicts      = dopt Opt_D_dump_asm_conflicts dflags
-   , ncgBmiVersion            = case platformArch (targetPlatform dflags) of
-                                 ArchX86_64 -> bmiVersion dflags
-                                 ArchX86    -> bmiVersion dflags
-                                 _          -> Nothing
-
-     -- We Assume  SSE1 and SSE2 operations are available on both
-     -- x86 and x86_64. Historically we didn't default to SSE2 and
-     -- SSE1 on x86, which results in defacto nondeterminism for how
-     -- rounding behaves in the associated x87 floating point instructions
-     -- because variations in the spill/fpu stack placement of arguments for
-     -- operations would change the precision and final result of what
-     -- would otherwise be the same expressions with respect to single or
-     -- double precision IEEE floating point computations.
-   , ncgSseVersion =
-      let v | sseVersion dflags < Just SSE2 = Just SSE2
-            | otherwise                     = sseVersion dflags
-      in case platformArch (targetPlatform dflags) of
-            ArchX86_64 -> v
-            ArchX86    -> v
-            _          -> Nothing
-   }
-
 initNat :: NatM_State -> NatM a -> (a, NatM_State)
 initNat init_st m
         = case unNat m init_st of { (r,st) -> (r,st) }
@@ -234,13 +188,12 @@ getUniqueNat = NatM $ \ st ->
     case takeUniqFromSupply $ natm_us st of
     (uniq, us') -> (uniq, st {natm_us = us'})
 
-instance HasDynFlags NatM where
-    getDynFlags = NatM $ \ st -> (natm_dflags st, st)
-
-
 getDeltaNat :: NatM Int
 getDeltaNat = NatM $ \ st -> (natm_delta st, st)
 
+-- | Get CFG edge weights
+getCfgWeights :: NatM Weights
+getCfgWeights = NatM $ \ st -> (ncgCfgWeights (natm_config st), st)
 
 setDeltaNat :: Int -> NatM ()
 setDeltaNat delta = NatM $ \ st -> ((), st {natm_delta = delta})
@@ -262,9 +215,8 @@ updateCfgNat f
 -- | Record that we added a block between `from` and `old`.
 addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM ()
 addNodeBetweenNat from between to
- = do   df <- getDynFlags
-        let jmpWeight = fromIntegral . uncondWeight .
-                        cfgWeightInfo $ df
+ = do   weights <- getCfgWeights
+        let jmpWeight = fromIntegral (uncondWeight weights)
         updateCfgNat (updateCfg jmpWeight from between to)
   where
     -- When transforming A -> B to A -> A' -> B
@@ -284,8 +236,8 @@ addNodeBetweenNat from between to
 --   block -> X to `succ` -> X
 addImmediateSuccessorNat :: BlockId -> BlockId -> NatM ()
 addImmediateSuccessorNat block succ = do
-   dflags <- getDynFlags
-   updateCfgNat (addImmediateSuccessor dflags block succ)
+   weights <- getCfgWeights
+   updateCfgNat (addImmediateSuccessor weights block succ)
 
 getBlockIdNat :: NatM BlockId
 getBlockIdNat
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 51ee9ffce9..cbf3da9925 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -57,6 +57,7 @@ import GHC.CmmToAsm.Monad
    , getDeltaNat, getBlockIdNat, getPicBaseNat, getNewRegPairNat
    , getPicBaseMaybeNat, getDebugBlock, getFileId
    , addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform
+   , getCfgWeights
    )
 import GHC.CmmToAsm.CFG
 import GHC.CmmToAsm.Format
@@ -2106,10 +2107,10 @@ genCCall is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] bid
       --  bid -> lbl2
       --  bid -> lbl1 -> lbl2
       --  We also changes edges originating at bid to start at lbl2 instead.
-      dflags <- getDynFlags
+      weights <- getCfgWeights
       updateCfgNat (addWeightEdge bid lbl1 110 .
                     addWeightEdge lbl1 lbl2 110 .
-                    addImmediateSuccessor dflags bid lbl2)
+                    addImmediateSuccessor weights bid lbl2)
 
       -- The following instruction sequence corresponds to the pseudo-code
       --
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index fea01278ef..40ccb400bc 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -226,9 +226,6 @@ module GHC.Driver.Session (
 
         -- * SDoc
         initSDocContext, initDefaultSDocContext,
-
-        -- * Make use of the Cmm CFG
-        CfgWeights(..)
   ) where
 
 #include "HsVersions.h"
@@ -268,6 +265,7 @@ import GHC.Data.FastString
 import GHC.Utils.Fingerprint
 import GHC.Utils.Outputable
 import GHC.Settings
+import GHC.CmmToAsm.CFG.Weight
 
 import {-# SOURCE #-} GHC.Utils.Error
                                ( Severity(..), MsgDoc, mkLocMessageAnn
@@ -777,78 +775,9 @@ data DynFlags = DynFlags {
   uniqueIncrement       :: Int,
 
   -- | Temporary: CFG Edge weights for fast iterations
-  cfgWeightInfo         :: CfgWeights
+  cfgWeights            :: Weights
 }
 
--- | Edge weights to use when generating a CFG from CMM
-data CfgWeights
-    = CFGWeights
-    { uncondWeight :: Int
-    , condBranchWeight :: Int
-    , switchWeight :: Int
-    , callWeight :: Int
-    , likelyCondWeight :: Int
-    , unlikelyCondWeight :: Int
-    , infoTablePenalty :: Int
-    , backEdgeBonus :: Int
-    }
-
-defaultCfgWeights :: CfgWeights
-defaultCfgWeights
-    = CFGWeights
-    { uncondWeight = 1000
-    , condBranchWeight = 800
-    , switchWeight = 1
-    , callWeight = -10
-    , likelyCondWeight = 900
-    , unlikelyCondWeight = 300
-    , infoTablePenalty = 300
-    , backEdgeBonus = 400
-    }
-
-parseCfgWeights :: String -> CfgWeights -> CfgWeights
-parseCfgWeights s oldWeights =
-        foldl' (\cfg (n,v) -> update n v cfg) oldWeights assignments
-    where
-        assignments = map assignment $ settings s
-        update "uncondWeight" n w =
-            w {uncondWeight = n}
-        update "condBranchWeight" n w =
-            w {condBranchWeight = n}
-        update "switchWeight" n w =
-            w {switchWeight = n}
-        update "callWeight" n w =
-            w {callWeight = n}
-        update "likelyCondWeight" n w =
-            w {likelyCondWeight = n}
-        update "unlikelyCondWeight" n w =
-            w {unlikelyCondWeight = n}
-        update "infoTablePenalty" n w =
-            w {infoTablePenalty = n}
-        update "backEdgeBonus" n w =
-            w {backEdgeBonus = n}
-        update other _ _
-            = panic $ other ++
-                      " is not a cfg weight parameter. " ++
-                      exampleString
-        settings s
-            | (s1,rest) <- break (== ',') s
-            , null rest
-            = [s1]
-            | (s1,rest) <- break (== ',') s
-            = s1 : settings (drop 1 rest)
-
-        assignment as
-            | (name, _:val) <- break (== '=') as
-            = (name,read val)
-            | otherwise
-            = panic $ "Invalid cfg parameters." ++ exampleString
-
-        exampleString = "Example parameters: uncondWeight=1000," ++
-            "condBranchWeight=800,switchWeight=0,callWeight=300" ++
-            ",likelyCondWeight=900,unlikelyCondWeight=300" ++
-            ",infoTablePenalty=300,backEdgeBonus=400"
-
 class HasDynFlags m where
     getDynFlags :: m DynFlags
 
@@ -1430,7 +1359,7 @@ defaultDynFlags mySettings llvmConfig =
 
         reverseErrors = False,
         maxErrors     = Nothing,
-        cfgWeightInfo = defaultCfgWeights
+        cfgWeights    = defaultWeights
       }
 
 defaultWays :: Settings -> Ways
@@ -2949,8 +2878,8 @@ dynamic_flags_deps = [
       (intSuffix (\n d -> d { cmmProcAlignment = Just n }))
   , make_ord_flag defFlag "fblock-layout-weights"
         (HasArg (\s ->
-            upd (\d -> d { cfgWeightInfo =
-                parseCfgWeights s (cfgWeightInfo d)})))
+            upd (\d -> d { cfgWeights =
+                parseWeights s (cfgWeights d)})))
   , make_ord_flag defFlag "fhistory-size"
       (intSuffix (\n d -> d { historySize = n }))
   , make_ord_flag defFlag "funfolding-creation-threshold"
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 9a12e16d53..fb2affbd1d 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -581,6 +581,7 @@ Library
             GHC.CmmToAsm.Instr
             GHC.CmmToAsm.BlockLayout
             GHC.CmmToAsm.CFG
+            GHC.CmmToAsm.CFG.Weight
             GHC.CmmToAsm.CFG.Dominators
             GHC.CmmToAsm.Format
             GHC.Platform.Reg
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs
index 5e23821678..409522d2e8 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.hs
+++ b/testsuite/tests/parser/should_run/CountParserDeps.hs
@@ -30,7 +30,7 @@ main = do
   let num = sizeUniqSet modules
 --  print num
 --  print (map moduleNameString $ nonDetEltsUniqSet modules)
-  unless (num < 200) $ exitWith (ExitFailure num)
+  unless (num <= 200) $ exitWith (ExitFailure num)
 
 parserDeps :: FilePath -> IO (UniqSet ModuleName)
 parserDeps libdir =
diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs
index 05ce9147d9..d8176cd644 100644
--- a/testsuite/tests/regalloc/regalloc_unit_tests.hs
+++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs
@@ -28,7 +28,6 @@ import GHC.Driver.Main
 import GHC.StgToCmm.CgUtils
 import GHC.CmmToAsm
 import GHC.CmmToAsm.Config
-import GHC.CmmToAsm.Monad as NCGConfig
 import GHC.Cmm.Info.Build
 import GHC.Cmm.Pipeline
 import GHC.Cmm.Parser
@@ -106,7 +105,7 @@ compileCmmForRegAllocStats ::
     IO [( Maybe [Color.RegAllocStats (Alignment, RawCmmStatics) X86.Instr.Instr]
         , Maybe [Linear.RegAllocStats])]
 compileCmmForRegAllocStats dflags' cmmFile ncgImplF us = do
-    let ncgImpl = ncgImplF (NCGConfig.initConfig dflags)
+    let ncgImpl = ncgImplF (initNCGConfig dflags)
     hscEnv <- newHscEnv dflags
 
     -- parse the cmm file and output any warnings or errors