From 29310b622801733e1b29a9a61988406872db13ca Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Sat, 10 Oct 2015 10:54:24 +1100 Subject: [PATCH] Switch to LLVM version 3.7 Before this commit, GHC only supported LLVM 3.6. Now it only supports LLVM 3.7 which was released in August 2015. LLVM version 3.6 and earlier do not work on AArch64/Arm64, but 3.7 does. Also: * Add CC_Ghc constructor to LlvmCallConvention. * Replace `maxSupportLlvmVersion`/`minSupportLlvmVersion` with a single `supportedLlvmVersion` variable. * Get `supportedLlvmVersion` from version specified in configure.ac. * Drop llvmVersion field from DynFlags (no longer needed because only one version is supported). Test Plan: Validate on x86_64 and arm Reviewers: bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1320 GHC Trac Issues: #10953 --- compiler/llvmGen/Llvm/PpLlvm.hs | 14 +++++--- compiler/llvmGen/Llvm/Types.hs | 3 ++ compiler/llvmGen/LlvmCodeGen.hs | 13 ++----- compiler/llvmGen/LlvmCodeGen/Base.hs | 20 ++++------- compiler/main/DriverPipeline.hs | 53 +++++++++------------------- compiler/main/DynFlags.hs | 5 --- compiler/main/SysTools.hs | 17 ++++----- configure.ac | 4 ++- 8 files changed, 51 insertions(+), 78 deletions(-) diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index 9234213203..cdaf962c4a 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -117,6 +117,7 @@ ppLlvmMeta (MetaNamed n m) -- | Print out an LLVM metadata value. ppLlvmMetaExpr :: MetaExpr -> SDoc +ppLlvmMetaExpr (MetaVar (LMLitVar (LMNullLit _))) = text "null" ppLlvmMetaExpr (MetaStr s ) = text "!" <> doubleQuotes (ftext s) ppLlvmMetaExpr (MetaNode n ) = text "!" <> int n ppLlvmMetaExpr (MetaVar v ) = ppr v @@ -280,7 +281,7 @@ ppCall ct fptr args attrs = case fptr of (case argTy of VarArgs -> text ", ..." FixedArgs -> empty) - fnty = space <> lparen <> ppArgTy <> rparen <> char '*' + fnty = space <> lparen <> ppArgTy <> rparen attrDoc = ppSpaceJoin attrs in tc <> text "call" <+> ppr cc <+> ppr ret <> fnty <+> ppName fptr <> lparen <+> ppValues @@ -362,8 +363,9 @@ ppCmpXChg addr old new s_ord f_ord = -- of specifying alignment. ppLoad :: LlvmVar -> SDoc -ppLoad var = text "load" <+> ppr var <> align +ppLoad var = text "load" <+> ppr derefType <> comma <+> ppr var <> align where + derefType = pLower $ getVarType var align | isVector . pLower . getVarType $ var = text ", align 1" | otherwise = empty @@ -373,7 +375,9 @@ ppALoad ord st var = sdocWithDynFlags $ \dflags -> align = text ", align" <+> ppr alignment sThreaded | st = text " singlethread" | otherwise = empty - in text "load atomic" <+> ppr var <> sThreaded <+> ppSyncOrdering ord <> align + derefType = pLower $ getVarType var + in text "load atomic" <+> ppr derefType <> comma <+> ppr var <> sThreaded + <+> ppSyncOrdering ord <> align ppStore :: LlvmVar -> LlvmVar -> SDoc ppStore val dst @@ -409,7 +413,9 @@ ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc ppGetElementPtr inb ptr idx = let indexes = comma <+> ppCommaJoin idx inbound = if inb then text "inbounds" else empty - in text "getelementptr" <+> inbound <+> ppr ptr <> indexes + derefType = pLower $ getVarType ptr + in text "getelementptr" <+> inbound <+> ppr derefType <> comma <+> ppr ptr + <> indexes ppReturn :: Maybe LlvmVar -> SDoc diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index 9780bf39cf..d533b4a993 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -568,6 +568,8 @@ data LlvmCallConvention -- does not support varargs and requires the prototype of all callees to -- exactly match the prototype of the function definition. | CC_Coldcc + -- | The GHC-specific 'registerised' calling convention. + | CC_Ghc -- | Any calling convention may be specified by number, allowing -- target-specific calling conventions to be used. Target specific calling -- conventions start at 64. @@ -581,6 +583,7 @@ instance Outputable LlvmCallConvention where ppr CC_Ccc = text "ccc" ppr CC_Fastcc = text "fastcc" ppr CC_Coldcc = text "coldcc" + ppr CC_Ghc = text "ghccc" ppr (CC_Ncc i) = text "cc " <> ppr i ppr CC_X86_Stdcc = text "x86_stdcallcc" diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index f0c184a348..345348470a 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -30,7 +30,6 @@ import SysTools ( figureLlvmVersion ) import qualified Stream import Control.Monad ( when ) -import Data.IORef ( writeIORef ) import Data.Maybe ( fromMaybe, catMaybes ) import System.IO @@ -47,21 +46,15 @@ llvmCodeGen dflags h us cmm_stream showPass dflags "LLVM CodeGen" -- get llvm version, cache for later use - ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags - writeIORef (llvmVersion dflags) ver + ver <- (fromMaybe supportedLlvmVersion) `fmap` figureLlvmVersion dflags -- warn if unsupported debugTraceMsg dflags 2 (text "Using LLVM version:" <+> text (show ver)) let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags - when (ver < minSupportLlvmVersion && doWarn) $ - errorMsg dflags (text "You are using an old version of LLVM that" - <> text " isn't supported anymore!" + when (ver /= supportedLlvmVersion && doWarn) $ + putMsg dflags (text "You are using an unsupported version of LLVM!" $+$ text "We will try though...") - when (ver > maxSupportLlvmVersion && doWarn) $ - putMsg dflags (text "You are using a new version of LLVM that" - <> text " hasn't been tested yet!" - $+$ text "We will try though...") -- run code generation runLlvm dflags ver bufh us $ diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 5ef0a4bbfa..510d01f1d7 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -12,8 +12,7 @@ module LlvmCodeGen.Base ( LiveGlobalRegs, LlvmUnresData, LlvmData, UnresLabel, UnresStatic, - LlvmVersion, defaultLlvmVersion, minSupportLlvmVersion, - maxSupportLlvmVersion, + LlvmVersion, supportedLlvmVersion, LlvmM, runLlvm, liftStream, withClearVars, varLookup, varInsert, @@ -36,6 +35,7 @@ module LlvmCodeGen.Base ( ) where #include "HsVersions.h" +#include "ghcautoconf.h" import Llvm import LlvmCodeGen.Regs @@ -111,7 +111,7 @@ widthToLlvmInt w = LMInt $ widthInBits w llvmGhcCC :: DynFlags -> LlvmCallConvention llvmGhcCC dflags | platformUnregisterised (targetPlatform dflags) = CC_Ccc - | otherwise = CC_Ncc 10 + | otherwise = CC_Ghc -- | Llvm Function type for Cmm function llvmFunTy :: LiveGlobalRegs -> LlvmM LlvmType @@ -172,17 +172,11 @@ llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags -- -- | LLVM Version Number -type LlvmVersion = Int +type LlvmVersion = (Int, Int) --- | The LLVM Version we assume if we don't know -defaultLlvmVersion :: LlvmVersion -defaultLlvmVersion = 36 - -minSupportLlvmVersion :: LlvmVersion -minSupportLlvmVersion = 36 - -maxSupportLlvmVersion :: LlvmVersion -maxSupportLlvmVersion = 36 +-- | The LLVM Version that is currently supported. +supportedLlvmVersion :: LlvmVersion +supportedLlvmVersion = sUPPORTED_LLVM_VERSION -- ---------------------------------------------------------------------------- -- * Environment Handling diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 02f3caf5c9..5aaf4754e6 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -66,7 +66,6 @@ import TcRnTypes import Hooks import Exception -import Data.IORef ( readIORef ) import System.Directory import System.FilePath import System.IO @@ -1259,14 +1258,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags -- assembler, so we use clang as the assembler instead. (#5636) let whichAsProg | hscTarget dflags == HscLlvm && platformOS (targetPlatform dflags) == OSDarwin - = do - -- be careful what options we call clang with - -- see #5903 and #7617 for bugs caused by this. - llvmVer <- liftIO $ figureLlvmVersion dflags - return $ case llvmVer of - Just n | n >= 30 -> SysTools.runClang - _ -> SysTools.runAs - + = return SysTools.runClang | otherwise = return SysTools.runAs as_prog <- whichAsProg @@ -1408,18 +1400,15 @@ runPhase (RealPhase SplitAs) _input_fn dflags runPhase (RealPhase LlvmOpt) input_fn dflags = do - ver <- liftIO $ readIORef (llvmVersion dflags) - let opt_lvl = max 0 (min 2 $ optLevel dflags) -- don't specify anything if user has specified commands. We do this -- for opt but not llc since opt is very specifically for optimisation -- passes only, so if the user is passing us extra options we assume -- they know what they are doing and don't get in the way. optFlag = if null (getOpts dflags opt_lo) - then map SysTools.Option $ words (llvmOpts ver !! opt_lvl) + then map SysTools.Option $ words (llvmOpts !! opt_lvl) else [] - tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier - | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" + tbaa | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" | otherwise = "--enable-tbaa=false" @@ -1433,22 +1422,19 @@ runPhase (RealPhase LlvmOpt) input_fn dflags ++ [SysTools.Option tbaa]) return (RealPhase LlvmLlc, output_fn) - where + 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 ver = [ "-mem2reg -globalopt" - , if ver >= 34 then "-O1 -globalopt" else "-O1" - -- LLVM 3.4 -O1 doesn't eliminate aliases reliably (bug #8855) - , "-O2" - ] + llvmOpts = [ "-mem2reg -globalopt" + , "-O1 -globalopt" + , "-O2" + ] ----------------------------------------------------------------------------- -- LlvmLlc phase runPhase (RealPhase LlvmLlc) input_fn dflags = do - ver <- liftIO $ readIORef (llvmVersion dflags) - let opt_lvl = max 0 (min 2 $ optLevel dflags) -- iOS requires external references to be loaded indirectly from the -- DATA segment or dyld traps at runtime writing into TEXT: see #7722 @@ -1456,8 +1442,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags | gopt Opt_PIC dflags = "pic" | not (gopt Opt_Static dflags) = "dynamic-no-pic" | otherwise = "static" - tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier - | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" + tbaa | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" | otherwise = "--enable-tbaa=false" -- hidden debugging flag '-dno-llvm-mangler' to skip mangling @@ -1465,13 +1450,8 @@ runPhase (RealPhase LlvmLlc) input_fn dflags False -> LlvmMangle True | gopt Opt_SplitObjs dflags -> Splitter True -> As False - - output_fn <- phaseOutputFilename next_phase - -- AVX can cause LLVM 3.2 to generate a C-like frame pointer - -- prelude, see #9391 - when (ver == 32 && isAvxEnabled dflags) $ liftIO $ errorMsg dflags $ text - "Note: LLVM 3.2 has known problems with AVX instructions (see trac #9391)" + output_fn <- phaseOutputFilename next_phase liftIO $ SysTools.runLlvmLlc dflags ([ SysTools.Option (llvmOpts !! opt_lvl), @@ -1482,7 +1462,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags ++ map SysTools.Option fpOpts ++ map SysTools.Option abiOpts ++ map SysTools.Option sseOpts - ++ map SysTools.Option (avxOpts ver) + ++ map SysTools.Option avxOpts ++ map SysTools.Option avx512Opts ++ map SysTools.Option stackAlignOpts) @@ -1495,7 +1475,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags -- On ARMv7 using LLVM, LLVM fails to allocate floating point registers -- while compiling GHC source code. It's probably due to fact that it -- does not enable VFP by default. Let's do this manually here - fpOpts = case platformArch (targetPlatform dflags) of + fpOpts = case platformArch (targetPlatform dflags) of ArchARM ARMv7 ext _ -> if (elem VFPv3 ext) then ["-mattr=+v7,+vfp3"] else if (elem VFPv3D16 ext) @@ -1518,11 +1498,10 @@ runPhase (RealPhase LlvmLlc) input_fn dflags | isSseEnabled dflags = ["-mattr=+sse"] | otherwise = [] - avxOpts ver | isAvx512fEnabled dflags = ["-mattr=+avx512f"] - | isAvx2Enabled dflags = ["-mattr=+avx2"] - | isAvxEnabled dflags = ["-mattr=+avx"] - | ver == 32 = ["-mattr=-avx"] -- see #9391 - | otherwise = [] + avxOpts | isAvx512fEnabled dflags = ["-mattr=+avx512f"] + | isAvx2Enabled dflags = ["-mattr=+avx2"] + | isAvxEnabled dflags = ["-mattr=+avx"] + | otherwise = [] avx512Opts = [ "-mattr=+avx512cd" | isAvx512cdEnabled dflags ] ++ diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0bb816c3be..1f04f60562 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -868,8 +868,6 @@ data DynFlags = DynFlags { interactivePrint :: Maybe String, - llvmVersion :: IORef Int, - nextWrapperNum :: IORef (ModuleEnv Int), -- | Machine dependant flags (-m stuff) @@ -1377,7 +1375,6 @@ initDynFlags dflags = do refDirsToClean <- newIORef Map.empty refFilesToNotIntermediateClean <- newIORef [] refGeneratedDumps <- newIORef Set.empty - refLlvmVersion <- newIORef 28 refRtldInfo <- newIORef Nothing refRtccInfo <- newIORef Nothing wrapperNum <- newIORef emptyModuleEnv @@ -1394,7 +1391,6 @@ initDynFlags dflags = do dirsToClean = refDirsToClean, filesToNotIntermediateClean = refFilesToNotIntermediateClean, generatedDumps = refGeneratedDumps, - llvmVersion = refLlvmVersion, nextWrapperNum = wrapperNum, useUnicode = canUseUnicode, rtldInfo = refRtldInfo, @@ -1547,7 +1543,6 @@ defaultDynFlags mySettings = useUnicode = False, traceLevel = 1, profAuto = NoProfAuto, - llvmVersion = panic "defaultDynFlags: No llvmVersion", interactivePrint = Nothing, nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum", sseVersion = Nothing, diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 77dbceae98..20f172b7d8 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -613,7 +613,7 @@ runClang dflags args = do ) -- | Figure out which version of LLVM we are running this session -figureLlvmVersion :: DynFlags -> IO (Maybe Int) +figureLlvmVersion :: DynFlags -> IO (Maybe (Int, Int)) figureLlvmVersion dflags = do let (pgm,opts) = pgm_lc dflags args = filter notNull (map showOpt opts) @@ -626,17 +626,18 @@ figureLlvmVersion dflags = do (pin, pout, perr, _) <- runInteractiveProcess pgm args' Nothing Nothing {- > llc -version - Low Level Virtual Machine (http://llvm.org/): - llvm version 2.8 (Ubuntu 2.8-0Ubuntu1) + LLVM (http://llvm.org/): + LLVM version 3.5.2 ... -} hSetBinaryMode pout False _ <- hGetLine pout - vline <- hGetLine pout - v <- case filter isDigit vline of - [] -> fail "no digits!" - [x] -> fail $ "only 1 digit! (" ++ show x ++ ")" - (x:y:_) -> return ((read [x,y]) :: Int) + vline <- dropWhile (not . isDigit) `fmap` hGetLine pout + v <- case span (/= '.') vline of + ("",_) -> fail "no digits!" + (x,y) -> return (read x + , read $ takeWhile isDigit $ drop 1 y) + hClose pin hClose pout hClose perr diff --git a/configure.ac b/configure.ac index c9a6ed0020..832ca22a06 100644 --- a/configure.ac +++ b/configure.ac @@ -553,8 +553,10 @@ esac # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around # 3.5/3.6 release of LLVM. -LlvmVersion=3.6 +LlvmVersion=3.7 AC_SUBST([LlvmVersion]) +sUPPORTED_LLVM_VERSION=$(echo \($LlvmVersion\) | sed 's/\./,/') +AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION], ${sUPPORTED_LLVM_VERSION}, [The supported LLVM version number]) dnl ** Which LLVM llc to use? dnl -------------------------------------------------------------- -- GitLab