summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/llvmGen/LlvmCodeGen.hs14
-rw-r--r--compiler/main/DriverPipeline.hs4
-rw-r--r--compiler/main/DynFlags.hs25
-rw-r--r--compiler/main/GHC.hs2
-rw-r--r--compiler/main/SysTools.hs32
-rw-r--r--ghc/GHCi/UI.hs8
-rw-r--r--testsuite/tests/hiefile/should_run/PatTypes.hs2
-rwxr-xr-xutils/llvm-targets/gen-data-layout.sh3
8 files changed, 59 insertions, 31 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index cc86c4254e..b566b99a1f 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -94,12 +94,18 @@ llvmCodeGen' cmm_stream
header :: SDoc
header = sdocWithDynFlags $ \dflags ->
let target = platformMisc_llvmTarget $ platformMisc dflags
- layout = case lookup target (llvmTargets dflags) of
- Just (LlvmTarget dl _ _) -> dl
- Nothing -> error $ "Failed to lookup the datalayout for " ++ target ++ "; available targets: " ++ show (map fst $ llvmTargets dflags)
- in text ("target datalayout = \"" ++ layout ++ "\"")
+ in text ("target datalayout = \"" ++ getDataLayout dflags target ++ "\"")
$+$ text ("target triple = \"" ++ target ++ "\"")
+ getDataLayout :: DynFlags -> String -> String
+ getDataLayout dflags target =
+ case lookup target (llvmTargets $ llvmConfig dflags) of
+ Just (LlvmTarget {lDataLayout=dl}) -> dl
+ Nothing -> pprPanic "Failed to lookup LLVM data layout" $
+ text "Target:" <+> text target $$
+ hang (text "Available targets:") 4
+ (vcat $ map (text . fst) $ llvmTargets $ llvmConfig dflags)
+
llvmGroupLlvmGens :: RawCmmGroup -> LlvmM ()
llvmGroupLlvmGens cmm = do
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 87128c2b6e..a71f4d991b 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -901,7 +901,7 @@ llvmOptions dflags =
++ [("", "-mattr=" ++ attrs) | not (null attrs) ]
where target = platformMisc_llvmTarget $ platformMisc dflags
- Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets dflags)
+ Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets $ llvmConfig dflags)
-- Relocation models
rmodel | gopt Opt_PIC dflags = "pic"
@@ -1450,7 +1450,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
-- we always (unless -optlo specified) run Opt since we rely on it to
-- fix up some pretty big deficiencies in the code we generate
optIdx = max 0 $ min 2 $ optLevel dflags -- ensure we're in [0,2]
- llvmOpts = case lookup optIdx $ llvmPasses dflags of
+ llvmOpts = case lookup optIdx $ llvmPasses $ llvmConfig dflags of
Just passes -> passes
Nothing -> panic ("runPhase LlvmOpt: llvm-passes file "
++ "is missing passes for level "
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 465dd2737b..146020887b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -83,7 +83,7 @@ module DynFlags (
unsafeFlags, unsafeFlagsForInfer,
-- ** LLVM Targets
- LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig,
+ LlvmTarget(..), LlvmConfig(..),
-- ** System tool settings and locations
Settings(..),
@@ -970,8 +970,9 @@ data DynFlags = DynFlags {
integerLibrary :: IntegerLibrary,
-- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden
-- by GHC-API users. See Note [The integer library] in PrelNames
- llvmTargets :: LlvmTargets,
- llvmPasses :: LlvmPasses,
+ llvmConfig :: LlvmConfig,
+ -- ^ N.B. It's important that this field is lazy since we load the LLVM
+ -- configuration lazily. See Note [LLVM Configuration] in SysTools.
verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
optLevel :: Int, -- ^ Optimisation level
debugLevel :: Int, -- ^ How much debug information to produce
@@ -1391,9 +1392,10 @@ data LlvmTarget = LlvmTarget
, lAttributes :: [String]
}
-type LlvmTargets = [(String, LlvmTarget)]
-type LlvmPasses = [(Int, String)]
-type LlvmConfig = (LlvmTargets, LlvmPasses)
+-- | See Note [LLVM Configuration] in SysTools.
+data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)]
+ , llvmPasses :: [(Int, String)]
+ }
-----------------------------------------------------------------------------
-- Accessessors from 'DynFlags'
@@ -1924,7 +1926,7 @@ 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 -> LlvmConfig -> DynFlags
-defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
+defaultDynFlags mySettings llvmConfig =
-- See Note [Updating flag description in the User's Guide]
DynFlags {
ghcMode = CompManager,
@@ -2035,8 +2037,8 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
platformConstants = sPlatformConstants mySettings,
rawSettings = sRawSettings mySettings,
- llvmTargets = myLlvmTargets,
- llvmPasses = myLlvmPasses,
+ -- See Note [LLVM configuration].
+ llvmConfig = llvmConfig,
-- ghc -M values
depMakefile = "Makefile",
@@ -5731,11 +5733,10 @@ makeDynFlagsConsistent dflags
-- initialized.
defaultGlobalDynFlags :: DynFlags
defaultGlobalDynFlags =
- (defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 }
+ (defaultDynFlags settings llvmConfig) { verbosity = 2 }
where
settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
- llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised"
- llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised"
+ llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised"
#if STAGE < 2
GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index f948f454a7..dc336e3914 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -505,7 +505,7 @@ initGhcMonad mb_top_dir
= do { env <- liftIO $
do { top_dir <- findTopDir mb_top_dir
; mySettings <- initSysTools top_dir
- ; myLlvmConfig <- initLlvmConfig top_dir
+ ; myLlvmConfig <- lazyInitLlvmConfig top_dir
; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)
; checkBrokenTablesNextToCode dflags
; setUnsafeGlobalDynFlags dflags
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index fa339bbb87..b3312b0dae 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -13,7 +13,7 @@
module SysTools (
-- * Initialisation
initSysTools,
- initLlvmConfig,
+ lazyInitLlvmConfig,
-- * Interface to system tools
module SysTools.Tasks,
@@ -52,6 +52,7 @@ import DynFlags
import Control.Monad.Trans.Except (runExceptT)
import System.FilePath
import System.IO
+import System.IO.Unsafe (unsafeInterleaveIO)
import SysTools.ExtraObj
import SysTools.Info
import SysTools.Tasks
@@ -110,13 +111,34 @@ stuff.
************************************************************************
-}
-initLlvmConfig :: String
+-- Note [LLVM configuration]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The `llvm-targets` and `llvm-passes` files are shipped with GHC and contain
+-- information needed by the LLVM backend to invoke `llc` and `opt`.
+-- Specifically:
+--
+-- * llvm-targets maps autoconf host triples to the corresponding LLVM
+-- `data-layout` declarations. This information is extracted from clang using
+-- the script in utils/llvm-targets/gen-data-layout.sh and should be updated
+-- whenever we target a new version of LLVM.
+--
+-- * llvm-passes maps GHC optimization levels to sets of LLVM optimization
+-- flags that GHC should pass to `opt`.
+--
+-- This information is contained in files rather the GHC source to allow users
+-- to add new targets to GHC without having to recompile the compiler.
+--
+-- Since this information is only needed by the LLVM backend we load it lazily
+-- with unsafeInterleaveIO. Consequently it is important that we lazily pattern
+-- match on LlvmConfig until we actually need its contents.
+
+lazyInitLlvmConfig :: String
-> IO LlvmConfig
-initLlvmConfig top_dir
- = do
+lazyInitLlvmConfig top_dir
+ = unsafeInterleaveIO $ do -- see Note [LLVM configuration]
targets <- readAndParse "llvm-targets" mkLlvmTarget
passes <- readAndParse "llvm-passes" id
- return (targets, passes)
+ return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes }
where
readAndParse name builder =
do let llvmConfigFile = top_dir </> name
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index e70992f667..4432244dca 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -2775,9 +2775,7 @@ showDynFlags show_all dflags = do
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) llvmConfig
+ default_dflags = defaultDynFlags (settings dflags) (llvmConfig dflags)
(ghciFlags,others) = partition (\f -> flagSpecFlag f `elem` flgs)
DynFlags.fFlags
@@ -3229,10 +3227,8 @@ 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) llvmConfig `lang_set`
+ defaultDynFlags (settings dflags) (llvmConfig dflags) `lang_set`
case language dflags of
Nothing -> Just Haskell2010
other -> other
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs
index af5c42defa..7948c43473 100644
--- a/testsuite/tests/hiefile/should_run/PatTypes.hs
+++ b/testsuite/tests/hiefile/should_run/PatTypes.hs
@@ -40,7 +40,7 @@ makeNc = do
dynFlagsForPrinting :: String -> IO DynFlags
dynFlagsForPrinting libdir = do
systemSettings <- initSysTools libdir
- return $ defaultDynFlags systemSettings ([], [])
+ return $ defaultDynFlags systemSettings (LlvmConfig [] [])
selectPoint :: HieFile -> (Int,Int) -> HieAST Int
selectPoint hf (sl,sc) = case M.toList (getAsts $ hie_asts hf) of
diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh
index 450d21903c..e55f6eccd9 100755
--- a/utils/llvm-targets/gen-data-layout.sh
+++ b/utils/llvm-targets/gen-data-layout.sh
@@ -15,6 +15,9 @@
#
# Add missing targets to the list below to have them included in
# llvm-targets file.
+#
+# See Note [LLVM Configuration] in SysTools for the whole story regarding LLVM
+# configuration data.
# Target sets for which to generate the llvm-targets file
TARGETS=(
View Lorry Controller Status