Commit b2577081 authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot

Refactor, document, and optimize LLVM configuration loading

As described in the new Note [LLVM Configuration] in SysTools, we now
load llvm-targets and llvm-passes lazily to avoid the overhead of doing
so when -fllvm isn't used (also known as "the common case").

Noticed in #17003.

Metric Decrease:
    T12234
    T12150
parent 825c108b
...@@ -94,12 +94,18 @@ llvmCodeGen' cmm_stream ...@@ -94,12 +94,18 @@ llvmCodeGen' cmm_stream
header :: SDoc header :: SDoc
header = sdocWithDynFlags $ \dflags -> header = sdocWithDynFlags $ \dflags ->
let target = platformMisc_llvmTarget $ platformMisc dflags let target = platformMisc_llvmTarget $ platformMisc dflags
layout = case lookup target (llvmTargets dflags) of in text ("target datalayout = \"" ++ getDataLayout dflags target ++ "\"")
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 ++ "\"")
$+$ text ("target triple = \"" ++ 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 :: RawCmmGroup -> LlvmM ()
llvmGroupLlvmGens cmm = do llvmGroupLlvmGens cmm = do
......
...@@ -901,7 +901,7 @@ llvmOptions dflags = ...@@ -901,7 +901,7 @@ llvmOptions dflags =
++ [("", "-mattr=" ++ attrs) | not (null attrs) ] ++ [("", "-mattr=" ++ attrs) | not (null attrs) ]
where target = platformMisc_llvmTarget $ platformMisc dflags 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 -- Relocation models
rmodel | gopt Opt_PIC dflags = "pic" rmodel | gopt Opt_PIC dflags = "pic"
...@@ -1450,7 +1450,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags ...@@ -1450,7 +1450,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
-- we always (unless -optlo specified) run Opt since we rely on it to -- we always (unless -optlo specified) run Opt since we rely on it to
-- fix up some pretty big deficiencies in the code we generate -- fix up some pretty big deficiencies in the code we generate
optIdx = max 0 $ min 2 $ optLevel dflags -- ensure we're in [0,2] 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 Just passes -> passes
Nothing -> panic ("runPhase LlvmOpt: llvm-passes file " Nothing -> panic ("runPhase LlvmOpt: llvm-passes file "
++ "is missing passes for level " ++ "is missing passes for level "
......
...@@ -83,7 +83,7 @@ module DynFlags ( ...@@ -83,7 +83,7 @@ module DynFlags (
unsafeFlags, unsafeFlagsForInfer, unsafeFlags, unsafeFlagsForInfer,
-- ** LLVM Targets -- ** LLVM Targets
LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig, LlvmTarget(..), LlvmConfig(..),
-- ** System tool settings and locations -- ** System tool settings and locations
Settings(..), Settings(..),
...@@ -970,8 +970,9 @@ data DynFlags = DynFlags { ...@@ -970,8 +970,9 @@ data DynFlags = DynFlags {
integerLibrary :: IntegerLibrary, integerLibrary :: IntegerLibrary,
-- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden
-- by GHC-API users. See Note [The integer library] in PrelNames -- by GHC-API users. See Note [The integer library] in PrelNames
llvmTargets :: LlvmTargets, llvmConfig :: LlvmConfig,
llvmPasses :: LlvmPasses, -- ^ 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] verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
optLevel :: Int, -- ^ Optimisation level optLevel :: Int, -- ^ Optimisation level
debugLevel :: Int, -- ^ How much debug information to produce debugLevel :: Int, -- ^ How much debug information to produce
...@@ -1391,9 +1392,10 @@ data LlvmTarget = LlvmTarget ...@@ -1391,9 +1392,10 @@ data LlvmTarget = LlvmTarget
, lAttributes :: [String] , lAttributes :: [String]
} }
type LlvmTargets = [(String, LlvmTarget)] -- | See Note [LLVM Configuration] in SysTools.
type LlvmPasses = [(Int, String)] data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)]
type LlvmConfig = (LlvmTargets, LlvmPasses) , llvmPasses :: [(Int, String)]
}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Accessessors from 'DynFlags' -- Accessessors from 'DynFlags'
...@@ -1924,7 +1926,7 @@ initDynFlags dflags = do ...@@ -1924,7 +1926,7 @@ initDynFlags dflags = do
-- | The normal 'DynFlags'. Note that they are not suitable for use in this form -- | The normal 'DynFlags'. Note that they are not suitable for use in this form
-- and must be fully initialized by 'GHC.runGhc' first. -- and must be fully initialized by 'GHC.runGhc' first.
defaultDynFlags :: Settings -> LlvmConfig -> DynFlags defaultDynFlags :: Settings -> LlvmConfig -> DynFlags
defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = defaultDynFlags mySettings llvmConfig =
-- See Note [Updating flag description in the User's Guide] -- See Note [Updating flag description in the User's Guide]
DynFlags { DynFlags {
ghcMode = CompManager, ghcMode = CompManager,
...@@ -2035,8 +2037,8 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = ...@@ -2035,8 +2037,8 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
platformConstants = sPlatformConstants mySettings, platformConstants = sPlatformConstants mySettings,
rawSettings = sRawSettings mySettings, rawSettings = sRawSettings mySettings,
llvmTargets = myLlvmTargets, -- See Note [LLVM configuration].
llvmPasses = myLlvmPasses, llvmConfig = llvmConfig,
-- ghc -M values -- ghc -M values
depMakefile = "Makefile", depMakefile = "Makefile",
...@@ -5731,11 +5733,10 @@ makeDynFlagsConsistent dflags ...@@ -5731,11 +5733,10 @@ makeDynFlagsConsistent dflags
-- initialized. -- initialized.
defaultGlobalDynFlags :: DynFlags defaultGlobalDynFlags :: DynFlags
defaultGlobalDynFlags = defaultGlobalDynFlags =
(defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 } (defaultDynFlags settings llvmConfig) { verbosity = 2 }
where where
settings = panic "v_unsafeGlobalDynFlags: settings not initialised" settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised" llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised"
llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised"
#if STAGE < 2 #if STAGE < 2
GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags) GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
......
...@@ -505,7 +505,7 @@ initGhcMonad mb_top_dir ...@@ -505,7 +505,7 @@ initGhcMonad mb_top_dir
= do { env <- liftIO $ = do { env <- liftIO $
do { top_dir <- findTopDir mb_top_dir do { top_dir <- findTopDir mb_top_dir
; mySettings <- initSysTools top_dir ; mySettings <- initSysTools top_dir
; myLlvmConfig <- initLlvmConfig top_dir ; myLlvmConfig <- lazyInitLlvmConfig top_dir
; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig) ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)
; checkBrokenTablesNextToCode dflags ; checkBrokenTablesNextToCode dflags
; setUnsafeGlobalDynFlags dflags ; setUnsafeGlobalDynFlags dflags
......
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
module SysTools ( module SysTools (
-- * Initialisation -- * Initialisation
initSysTools, initSysTools,
initLlvmConfig, lazyInitLlvmConfig,
-- * Interface to system tools -- * Interface to system tools
module SysTools.Tasks, module SysTools.Tasks,
...@@ -52,6 +52,7 @@ import DynFlags ...@@ -52,6 +52,7 @@ import DynFlags
import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Trans.Except (runExceptT)
import System.FilePath import System.FilePath
import System.IO import System.IO
import System.IO.Unsafe (unsafeInterleaveIO)
import SysTools.ExtraObj import SysTools.ExtraObj
import SysTools.Info import SysTools.Info
import SysTools.Tasks import SysTools.Tasks
...@@ -110,13 +111,34 @@ stuff. ...@@ -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 -> IO LlvmConfig
initLlvmConfig top_dir lazyInitLlvmConfig top_dir
= do = unsafeInterleaveIO $ do -- see Note [LLVM configuration]
targets <- readAndParse "llvm-targets" mkLlvmTarget targets <- readAndParse "llvm-targets" mkLlvmTarget
passes <- readAndParse "llvm-passes" id passes <- readAndParse "llvm-passes" id
return (targets, passes) return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes }
where where
readAndParse name builder = readAndParse name builder =
do let llvmConfigFile = top_dir </> name do let llvmConfigFile = top_dir </> name
......
...@@ -2775,9 +2775,7 @@ showDynFlags show_all dflags = do ...@@ -2775,9 +2775,7 @@ showDynFlags show_all dflags = do
is_on = test f dflags is_on = test f dflags
quiet = not show_all && test f default_dflags == is_on quiet = not show_all && test f default_dflags == is_on
llvmConfig = (llvmTargets dflags, llvmPasses dflags) default_dflags = defaultDynFlags (settings dflags) (llvmConfig dflags)
default_dflags = defaultDynFlags (settings dflags) llvmConfig
(ghciFlags,others) = partition (\f -> flagSpecFlag f `elem` flgs) (ghciFlags,others) = partition (\f -> flagSpecFlag f `elem` flgs)
DynFlags.fFlags DynFlags.fFlags
...@@ -3229,10 +3227,8 @@ showLanguages' show_all dflags = ...@@ -3229,10 +3227,8 @@ showLanguages' show_all dflags =
is_on = test f dflags is_on = test f dflags
quiet = not show_all && test f default_dflags == is_on quiet = not show_all && test f default_dflags == is_on
llvmConfig = (llvmTargets dflags, llvmPasses dflags)
default_dflags = default_dflags =
defaultDynFlags (settings dflags) llvmConfig `lang_set` defaultDynFlags (settings dflags) (llvmConfig dflags) `lang_set`
case language dflags of case language dflags of
Nothing -> Just Haskell2010 Nothing -> Just Haskell2010
other -> other other -> other
......
...@@ -40,7 +40,7 @@ makeNc = do ...@@ -40,7 +40,7 @@ makeNc = do
dynFlagsForPrinting :: String -> IO DynFlags dynFlagsForPrinting :: String -> IO DynFlags
dynFlagsForPrinting libdir = do dynFlagsForPrinting libdir = do
systemSettings <- initSysTools libdir systemSettings <- initSysTools libdir
return $ defaultDynFlags systemSettings ([], []) return $ defaultDynFlags systemSettings (LlvmConfig [] [])
selectPoint :: HieFile -> (Int,Int) -> HieAST Int selectPoint :: HieFile -> (Int,Int) -> HieAST Int
selectPoint hf (sl,sc) = case M.toList (getAsts $ hie_asts hf) of selectPoint hf (sl,sc) = case M.toList (getAsts $ hie_asts hf) of
......
...@@ -15,6 +15,9 @@ ...@@ -15,6 +15,9 @@
# #
# Add missing targets to the list below to have them included in # Add missing targets to the list below to have them included in
# llvm-targets file. # 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 # Target sets for which to generate the llvm-targets file
TARGETS=( TARGETS=(
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment