From a4ae199cf810a63444a4ef24a44b33329023cd93 Mon Sep 17 00:00:00 2001
From: Kavon Farvardin <kavon@farvard.in>
Date: Sun, 27 May 2018 11:49:25 -0400
Subject: [PATCH] Extract hard-coded LLVM opt flags into a file
To resolve ticket #11295, I think it makes sense to stop hard-coding
the pass sequences used by GHC when compiling with LLVM into the
compiler
itself.
This patchset introduces a companion to the existing `llvm-targets` file
called `llvm-passes`. The passes file is a simple association list that
holds the default LLVM `opt` pass sequence used by GHC. This allows end
users to easily save their favorite optimization flags when compiling
with LLVM.
The main benefit for ticket #11295 is that when adding a custom pass
sequence, it tends to be an extremely long string that would be
unsightly in the code.
This is essentially part 1 of 2 for ticket #11295.
Test Plan: ./validate
Reviewers: bgamari, angerman
Reviewed By: angerman
Subscribers: rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4695
---
compiler/main/DriverPipeline.hs | 10 ++++++----
compiler/main/DynFlags.hs | 13 +++++++++----
compiler/main/GHC.hs | 4 ++--
compiler/main/SysTools.hs | 26 ++++++++++++++++----------
ghc.mk | 7 ++++---
ghc/GHCi/UI.hs | 8 ++++++--
ghc/ghc.mk | 8 ++++++--
llvm-passes | 5 +++++
8 files changed, 54 insertions(+), 27 deletions(-)
create mode 100644 llvm-passes
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)
diff --git a/ghc.mk b/ghc.mk
index 1750434efa..4456bc3d03 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -1047,6 +1047,7 @@ $(eval $(call bindist-list,.,\
configure config.sub config.guess install-sh \
settings.in \
llvm-targets \
+ llvm-passes \
packages \
Makefile \
mk/config.mk.in \
@@ -1073,7 +1074,7 @@ $(eval $(call bindist-list,.,\
$(wildcard compiler/stage2/doc) \
$(wildcard libraries/*/dist-install/doc/) \
$(wildcard libraries/*/*/dist-install/doc/) \
- $(filter-out settings llvm-targets,$(INSTALL_LIBS)) \
+ $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \
$(RTS_INSTALL_LIBS) \
$(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \
mk/project.mk \
@@ -1106,7 +1107,7 @@ BIN_DIST_MK = $(BIN_DIST_PREP_DIR)/bindist.mk
unix-binary-dist-prep:
$(call removeTrees,bindistprep/)
"$(MKDIRHIER)" $(BIN_DIST_PREP_DIR)
- set -e; for i in packages LICENSE compiler ghc iserv rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh settings.in llvm-targets ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done
+ set -e; for i in packages LICENSE compiler ghc iserv rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh settings.in llvm-targets llvm-passes ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done
echo "HADDOCK_DOCS = $(HADDOCK_DOCS)" >> $(BIN_DIST_MK)
echo "BUILD_SPHINX_HTML = $(BUILD_SPHINX_HTML)" >> $(BIN_DIST_MK)
echo "BUILD_SPHINX_PDF = $(BUILD_SPHINX_PDF)" >> $(BIN_DIST_MK)
@@ -1204,7 +1205,7 @@ SRC_DIST_GHC_DIRS = mk rules docs distrib bindisttest libffi includes \
SRC_DIST_GHC_FILES += \
configure.ac config.guess config.sub configure \
aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile \
- install-sh settings.in llvm-targets VERSION GIT_COMMIT_ID \
+ install-sh settings.in llvm-targets llvm-passes VERSION GIT_COMMIT_ID \
boot packages ghc.mk MAKEHELP.md
.PHONY: VERSION
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index d449b3ca83..67f2cbb147 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -2568,7 +2568,9 @@ showDynFlags show_all dflags = do
is_on = test f dflags
quiet = not show_all && test f default_dflags == is_on
- default_dflags = defaultDynFlags (settings dflags) (llvmTargets dflags)
+ llvmConfig = (llvmTargets dflags, llvmPasses dflags)
+
+ default_dflags = defaultDynFlags (settings dflags) llvmConfig
(ghciFlags,others) = partition (\f -> flagSpecFlag f `elem` flgs)
DynFlags.fFlags
@@ -2979,8 +2981,10 @@ showLanguages' show_all dflags =
is_on = test f dflags
quiet = not show_all && test f default_dflags == is_on
+ llvmConfig = (llvmTargets dflags, llvmPasses dflags)
+
default_dflags =
- defaultDynFlags (settings dflags) (llvmTargets dflags) `lang_set`
+ defaultDynFlags (settings dflags) llvmConfig `lang_set`
case language dflags of
Nothing -> Just Haskell2010
other -> other
diff --git a/ghc/ghc.mk b/ghc/ghc.mk
index 20fa142df5..6e329352ef 100644
--- a/ghc/ghc.mk
+++ b/ghc/ghc.mk
@@ -135,6 +135,9 @@ $(INPLACE_LIB)/settings : settings
$(INPLACE_LIB)/llvm-targets : llvm-targets
"$(CP)" $< $@
+$(INPLACE_LIB)/llvm-passes : llvm-passes
+ "$(CP)" $< $@
+
$(INPLACE_LIB)/platformConstants: $(includes_GHCCONSTANTS_HASKELL_VALUE)
"$(CP)" $< $@
@@ -144,6 +147,7 @@ $(INPLACE_LIB)/platformConstants: $(includes_GHCCONSTANTS_HASKELL_VALUE)
GHC_DEPENDENCIES += $$(unlit_INPLACE)
GHC_DEPENDENCIES += $(INPLACE_LIB)/settings
GHC_DEPENDENCIES += $(INPLACE_LIB)/llvm-targets
+GHC_DEPENDENCIES += $(INPLACE_LIB)/llvm-passes
GHC_DEPENDENCIES += $(INPLACE_LIB)/platformConstants
$(GHC_STAGE1) : | $(GHC_DEPENDENCIES)
@@ -172,11 +176,12 @@ endif
INSTALL_LIBS += settings
INSTALL_LIBS += llvm-targets
+INSTALL_LIBS += llvm-passes
ifeq "$(Windows_Host)" "NO"
install: install_ghc_link
.PHONY: install_ghc_link
-install_ghc_link:
+install_ghc_link:
$(call removeFiles,"$(DESTDIR)$(bindir)/$(CrossCompilePrefix)ghc")
$(LN_S) $(CrossCompilePrefix)ghc-$(ProjectVersion) "$(DESTDIR)$(bindir)/$(CrossCompilePrefix)ghc"
else
@@ -188,4 +193,3 @@ install_ghc_post: install_bins
$(call removeFiles,"$(DESTDIR)$(bindir)/ghc.exe")
"$(MV)" -f $(DESTDIR)$(bindir)/ghc-stage$(INSTALL_GHC_STAGE).exe $(DESTDIR)$(bindir)/$(CrossCompilePrefix)ghc.exe
endif
-
diff --git a/llvm-passes b/llvm-passes
new file mode 100644
index 0000000000..5183c9f2ab
--- /dev/null
+++ b/llvm-passes
@@ -0,0 +1,5 @@
+[
+(0, "-mem2reg -globalopt"),
+(1, "-O1 -globalopt"),
+(2, "-O2")
+]
--
GitLab