diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 10 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 13 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 4 | ||||
| -rw-r--r-- | compiler/main/SysTools.hs | 26 |
4 files changed, 33 insertions, 20 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 0ed65d39fd..5ea83ce2c7 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1474,10 +1474,12 @@ runPhase (RealPhase LlvmOpt) input_fn dflags where -- we always (unless -optlo specified) run Opt since we rely on it to -- fix up some pretty big deficiencies in the code we generate - llvmOpts = case optLevel dflags of - 0 -> "-mem2reg -globalopt" - 1 -> "-O1 -globalopt" - _ -> "-O2" + optIdx = max 0 $ min 2 $ optLevel dflags -- ensure we're in [0,2] + llvmOpts = case lookup optIdx $ llvmPasses dflags of + Just passes -> passes + Nothing -> panic ("runPhase LlvmOpt: llvm-passes file " + ++ "is missing passes for level " + ++ show optIdx) -- don't specify anything if user has specified commands. We do this -- for opt but not llc since opt is very specifically for optimisation diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0406d0e03a..a20aac5689 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -79,7 +79,7 @@ module DynFlags ( unsafeFlags, unsafeFlagsForInfer, -- ** LLVM Targets - LlvmTarget(..), LlvmTargets, + LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig, -- ** System tool settings and locations Settings(..), @@ -830,6 +830,7 @@ data DynFlags = DynFlags { hscTarget :: HscTarget, settings :: Settings, llvmTargets :: LlvmTargets, + llvmPasses :: LlvmPasses, verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] optLevel :: Int, -- ^ Optimisation level debugLevel :: Int, -- ^ How much debug information to produce @@ -1146,6 +1147,8 @@ data LlvmTarget = LlvmTarget } type LlvmTargets = [(String, LlvmTarget)] +type LlvmPasses = [(Int, String)] +type LlvmConfig = (LlvmTargets, LlvmPasses) data Settings = Settings { sTargetPlatform :: Platform, -- Filled in by SysTools @@ -1722,8 +1725,8 @@ initDynFlags dflags = do -- | The normal 'DynFlags'. Note that they are not suitable for use in this form -- and must be fully initialized by 'GHC.runGhc' first. -defaultDynFlags :: Settings -> LlvmTargets -> DynFlags -defaultDynFlags mySettings myLlvmTargets = +defaultDynFlags :: Settings -> LlvmConfig -> DynFlags +defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = -- See Note [Updating flag description in the User's Guide] DynFlags { ghcMode = CompManager, @@ -1818,6 +1821,7 @@ defaultDynFlags mySettings myLlvmTargets = splitInfo = Nothing, settings = mySettings, llvmTargets = myLlvmTargets, + llvmPasses = myLlvmPasses, -- ghc -M values depMakefile = "Makefile", @@ -5473,10 +5477,11 @@ makeDynFlagsConsistent dflags -- initialized. defaultGlobalDynFlags :: DynFlags defaultGlobalDynFlags = - (defaultDynFlags settings llvmTargets) { verbosity = 2 } + (defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 } where settings = panic "v_unsafeGlobalDynFlags: settings not initialised" llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised" + llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised" #if STAGE < 2 GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 5f1eba5310..49e6c211eb 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -492,8 +492,8 @@ initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir = do { env <- liftIO $ do { mySettings <- initSysTools mb_top_dir - ; myLlvmTargets <- initLlvmTargets mb_top_dir - ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmTargets) + ; myLlvmConfig <- initLlvmConfig mb_top_dir + ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig) ; checkBrokenTablesNextToCode dflags ; setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 619e0b65e7..2e52ef97da 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -13,7 +13,7 @@ module SysTools ( -- * Initialisation initSysTools, - initLlvmTargets, + initLlvmConfig, -- * Interface to system tools module SysTools.Tasks, @@ -110,16 +110,22 @@ stuff. ************************************************************************ -} -initLlvmTargets :: Maybe String - -> IO LlvmTargets -initLlvmTargets mbMinusB - = do top_dir <- findTopDir mbMinusB - let llvmTargetsFile = top_dir </> "llvm-targets" - llvmTargetsStr <- readFile llvmTargetsFile - case maybeReadFuzzy llvmTargetsStr of - Just s -> return (fmap mkLlvmTarget <$> s) - Nothing -> pgmError ("Can't parse " ++ show llvmTargetsFile) +initLlvmConfig :: Maybe String + -> IO LlvmConfig +initLlvmConfig mbMinusB + = do + targets <- readAndParse "llvm-targets" mkLlvmTarget + passes <- readAndParse "llvm-passes" id + return (targets, passes) where + readAndParse name builder = + do top_dir <- findTopDir mbMinusB + let llvmConfigFile = top_dir </> name + llvmConfigStr <- readFile llvmConfigFile + case maybeReadFuzzy llvmConfigStr of + Just s -> return (fmap builder <$> s) + Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile) + mkLlvmTarget :: (String, String, String) -> LlvmTarget mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs) |