Commit 293c7fba authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

Put CFG weights into their own module (#17957)

It avoids having to query DynFlags to get them
parent eb9bdaef
......@@ -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
......
......@@ -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
}
......@@ -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
......
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"
......@@ -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
......
......@@ -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
......
......@@ -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
--
......
......@@ -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 =