diff options
Diffstat (limited to 'compiler/main')
-rw-r--r-- | compiler/main/DriverPipeline.hs | 272 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 36 | ||||
-rw-r--r-- | compiler/main/GHC.hs | 3 | ||||
-rw-r--r-- | compiler/main/HscTypes.hs | 1 | ||||
-rw-r--r-- | compiler/main/SysTools.hs | 27 |
5 files changed, 207 insertions, 132 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 40e6a8dead..4cfc48eaa3 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -67,7 +67,7 @@ import System.Directory import System.FilePath import System.IO import Control.Monad -import Data.List ( isSuffixOf ) +import Data.List ( isSuffixOf, intercalate ) import Data.Maybe import Data.Version @@ -378,7 +378,7 @@ link' dflags batch_attempt_linking hpt let staticLink = case ghcLink dflags of LinkStaticLib -> True - _ -> platformBinariesAreStaticLibs (targetPlatform dflags) + _ -> False home_mod_infos = eltsHpt hpt @@ -818,6 +818,63 @@ getOutputFilename stop_phase output basename dflags next_phase maybe_location | Just d <- odir = d </> persistent | otherwise = persistent + +-- | The fast LLVM Pipeline skips the mangler and assembler, +-- emiting object code dirctly from llc. +-- +-- slow: opt -> llc -> .s -> mangler -> as -> .o +-- fast: opt -> llc -> .o +-- +-- hidden flag: -ffast-llvm +-- +-- if keep-s-files is specified, we need to go through +-- the slow pipeline (Kavon Farvardin requested this). +fastLlvmPipeline :: DynFlags -> Bool +fastLlvmPipeline dflags + = not (gopt Opt_KeepSFiles dflags) && gopt Opt_FastLlvm dflags + +-- | LLVM Options. These are flags to be passed to opt and llc, to ensure +-- consistency we list them in pairs, so that they form groups. +llvmOptions :: DynFlags + -> [(String, String)] -- ^ pairs of (opt, llc) arguments +llvmOptions dflags = + [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] + ++ [("-relocation-model=" ++ rmodel + ,"-relocation-model=" ++ rmodel) | not (null rmodel)] + ++ [("-stack-alignment=" ++ (show align) + ,"-stack-alignment=" ++ (show align)) | align > 0 ] + ++ [("", "-filetype=obj") | fastLlvmPipeline dflags ] + + -- Additional llc flags + ++ [("", "-mcpu=" ++ mcpu) | not (null mcpu) ] + ++ [("", "-mattr=" ++ attrs) | not (null attrs) ] + + where target = LLVM_TARGET + Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets dflags) + + -- Relocation models + rmodel | gopt Opt_PIC dflags = "pic" + | positionIndependent dflags = "pic" + | WayDyn `elem` ways dflags = "dynamic-no-pic" + | otherwise = "static" + + align :: Int + align = case platformArch (targetPlatform dflags) of + ArchX86_64 | isAvxEnabled dflags -> 32 + _ -> 0 + + attrs :: String + attrs = intercalate "," $ mattr + ++ ["+sse42" | isSse4_2Enabled dflags ] + ++ ["+sse2" | isSse2Enabled dflags ] + ++ ["+sse" | isSseEnabled dflags ] + ++ ["+avx512f" | isAvx512fEnabled dflags ] + ++ ["+avx2" | isAvx2Enabled dflags ] + ++ ["+avx" | isAvxEnabled dflags ] + ++ ["+avx512cd"| isAvx512cdEnabled dflags ] + ++ ["+avx512er"| isAvx512erEnabled dflags ] + ++ ["+avx512pf"| isAvx512pfEnabled dflags ] + -- ----------------------------------------------------------------------------- -- | Each phase in the pipeline returns the next phase to execute, and the -- name of the file in which the output was placed. @@ -1419,121 +1476,115 @@ runPhase (RealPhase SplitAs) _input_fn dflags ----------------------------------------------------------------------------- -- LlvmOpt phase - runPhase (RealPhase LlvmOpt) input_fn dflags = do - 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 !! opt_lvl) - else [] - tbaa | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" - | otherwise = "--enable-tbaa=false" - - output_fn <- phaseOutputFilename LlvmLlc liftIO $ SysTools.runLlvmOpt dflags - ([ SysTools.FileOption "" input_fn, - SysTools.Option "-o", - SysTools.FileOption "" output_fn] - ++ optFlag - ++ [SysTools.Option tbaa]) + ( optFlag + ++ defaultOptions ++ + [ SysTools.FileOption "" input_fn + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn] + ) return (RealPhase LlvmLlc, output_fn) 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 = [ "-mem2reg -globalopt" - , "-O1 -globalopt" - , "-O2" - ] + llvmOpts = case optLevel dflags of + 0 -> "-mem2reg -globalopt" + 1 -> "-O1 -globalopt" + _ -> "-O2" + + -- 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 + else [] + + defaultOptions = map SysTools.Option . concat . fmap words . fst + $ unzip (llvmOptions dflags) ----------------------------------------------------------------------------- -- LlvmLlc phase runPhase (RealPhase LlvmLlc) input_fn dflags = do - 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 - rmodel | platformOS (targetPlatform dflags) == OSiOS = "dynamic-no-pic" - | positionIndependent dflags = "pic" - | WayDyn `elem` ways dflags = "dynamic-no-pic" - | otherwise = "static" - tbaa | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" - | otherwise = "--enable-tbaa=false" - - -- hidden debugging flag '-dno-llvm-mangler' to skip mangling - let next_phase = case gopt Opt_NoLlvmMangler dflags of - False -> LlvmMangle - True | gopt Opt_SplitObjs dflags -> Splitter - True -> As False + next_phase <- if fastLlvmPipeline dflags + then maybeMergeForeign + -- hidden debugging flag '-dno-llvm-mangler' to skip mangling + else case gopt Opt_NoLlvmMangler dflags of + False -> return LlvmMangle + True | gopt Opt_SplitObjs dflags -> return Splitter + True -> return (As False) output_fn <- phaseOutputFilename next_phase liftIO $ SysTools.runLlvmLlc dflags - ([ SysTools.Option (llvmOpts !! opt_lvl), - SysTools.Option $ "-relocation-model=" ++ rmodel, - SysTools.FileOption "" input_fn, - SysTools.Option "-o", SysTools.FileOption "" output_fn] - ++ [SysTools.Option tbaa] - ++ map SysTools.Option fpOpts - ++ map SysTools.Option abiOpts - ++ map SysTools.Option sseOpts - ++ map SysTools.Option avxOpts - ++ map SysTools.Option avx512Opts - ++ map SysTools.Option stackAlignOpts) + ( optFlag + ++ defaultOptions + ++ [ SysTools.FileOption "" input_fn + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ] + ) return (RealPhase next_phase, output_fn) where - -- Bug in LLVM at O3 on OSX. - llvmOpts = if platformOS (targetPlatform dflags) == OSDarwin - then ["-O1", "-O2", "-O2"] - else ["-O1", "-O2", "-O3"] - -- 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 - ArchARM ARMv7 ext _ -> if (elem VFPv3 ext) - then ["-mattr=+v7,+vfp3"] - else if (elem VFPv3D16 ext) - then ["-mattr=+v7,+vfp3,+d16"] - else [] - ArchARM ARMv6 ext _ -> if (elem VFPv2 ext) - then ["-mattr=+v6,+vfp2"] - else ["-mattr=+v6"] - _ -> [] - -- On Ubuntu/Debian with ARM hard float ABI, LLVM's llc still - -- compiles into soft-float ABI. We need to explicitly set abi - -- to hard - abiOpts = case platformArch (targetPlatform dflags) of - ArchARM _ _ HARD -> ["-float-abi=hard"] - ArchARM _ _ _ -> [] - _ -> [] - - sseOpts | isSse4_2Enabled dflags = ["-mattr=+sse42"] - | isSse2Enabled dflags = ["-mattr=+sse2"] - | isSseEnabled dflags = ["-mattr=+sse"] - | otherwise = [] - - avxOpts | isAvx512fEnabled dflags = ["-mattr=+avx512f"] - | isAvx2Enabled dflags = ["-mattr=+avx2"] - | isAvxEnabled dflags = ["-mattr=+avx"] - | otherwise = [] - - avx512Opts = - [ "-mattr=+avx512cd" | isAvx512cdEnabled dflags ] ++ - [ "-mattr=+avx512er" | isAvx512erEnabled dflags ] ++ - [ "-mattr=+avx512pf" | isAvx512pfEnabled dflags ] - - stackAlignOpts = - case platformArch (targetPlatform dflags) of - ArchX86_64 | isAvxEnabled dflags -> ["-stack-alignment=32"] - _ -> [] + -- Note [Clamping of llc optimizations] + -- + -- See #13724 + -- + -- we clamp the llc optimization between [1,2]. This is because passing -O0 + -- to llc 3.9 or llc 4.0, the naive register allocator can fail with + -- + -- Error while trying to spill R1 from class GPR: Cannot scavenge register + -- without an emergency spill slot! + -- + -- Observed at least with target 'arm-unknown-linux-gnueabihf'. + -- + -- + -- With LLVM4, llc -O3 crashes when ghc-stage1 tries to compile + -- rts/HeapStackCheck.cmm + -- + -- llc -O3 '-mtriple=arm-unknown-linux-gnueabihf' -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s + -- 0 llc 0x0000000102ae63e8 llvm::sys::PrintStackTrace(llvm::raw_ostream&) + 40 + -- 1 llc 0x0000000102ae69a6 SignalHandler(int) + 358 + -- 2 libsystem_platform.dylib 0x00007fffc23f4b3a _sigtramp + 26 + -- 3 libsystem_c.dylib 0x00007fffc226498b __vfprintf + 17876 + -- 4 llc 0x00000001029d5123 llvm::SelectionDAGISel::LowerArguments(llvm::Function const&) + 5699 + -- 5 llc 0x0000000102a21a35 llvm::SelectionDAGISel::SelectAllBasicBlocks(llvm::Function const&) + 3381 + -- 6 llc 0x0000000102a202b1 llvm::SelectionDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 1457 + -- 7 llc 0x0000000101bdc474 (anonymous namespace)::ARMDAGToDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 20 + -- 8 llc 0x00000001025573a6 llvm::MachineFunctionPass::runOnFunction(llvm::Function&) + 134 + -- 9 llc 0x000000010274fb12 llvm::FPPassManager::runOnFunction(llvm::Function&) + 498 + -- 10 llc 0x000000010274fd23 llvm::FPPassManager::runOnModule(llvm::Module&) + 67 + -- 11 llc 0x00000001027501b8 llvm::legacy::PassManagerImpl::run(llvm::Module&) + 920 + -- 12 llc 0x000000010195f075 compileModule(char**, llvm::LLVMContext&) + 12133 + -- 13 llc 0x000000010195bf0b main + 491 + -- 14 libdyld.dylib 0x00007fffc21e5235 start + 1 + -- Stack dump: + -- 0. Program arguments: llc -O3 -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s + -- 1. Running pass 'Function Pass Manager' on module '/var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc'. + -- 2. Running pass 'ARM Instruction Selection' on function '@"stg_gc_f1$def"' + -- + -- Observed at least with -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa + -- + llvmOpts = case optLevel dflags of + 0 -> "-O1" -- required to get the non-naive reg allocator. Passing -regalloc=greedy is not sufficient. + 1 -> "-O1" + _ -> "-O2" + + optFlag = if null (getOpts dflags opt_lc) + then map SysTools.Option $ words llvmOpts + else [] + + defaultOptions = map SysTools.Option . concat . fmap words . snd + $ unzip (llvmOptions dflags) + ----------------------------------------------------------------------------- -- LlvmMangle phase @@ -1892,22 +1943,19 @@ linkBinary' staticLink dflags o_files dep_packages = do -- Here are some libs that need to be linked at the *end* of -- the command line, because they contain symbols that are referred to -- by the RTS. We can't therefore use the ordinary way opts for these. - let - debug_opts | WayDebug `elem` ways dflags = [ + let debug_opts | WayDebug `elem` ways dflags = [ #if defined(HAVE_LIBBFD) "-lbfd", "-liberty" #endif ] - | otherwise = [] + | otherwise = [] - let thread_opts - | WayThreaded `elem` ways dflags = - let os = platformOS (targetPlatform dflags) - in if os `elem` [OSMinGW32, OSFreeBSD, OSOpenBSD, OSAndroid, - OSNetBSD, OSHaiku, OSQNXNTO, OSiOS, OSDarwin] - then [] - else ["-lpthread"] - | otherwise = [] + thread_opts | WayThreaded `elem` ways dflags = [ +#if NEED_PTHREAD_LIB + "-lpthread" +#endif + ] + | otherwise = [] rc_objs <- maybeCreateManifest dflags output_fn @@ -1942,7 +1990,7 @@ linkBinary' staticLink dflags o_files dep_packages = do -- on x86. ++ (if sLdSupportsCompactUnwind mySettings && not staticLink && - (platformOS platform == OSDarwin || platformOS platform == OSiOS) && + (platformOS platform == OSDarwin) && case platformArch platform of ArchX86 -> True ArchX86_64 -> True @@ -1952,13 +2000,6 @@ linkBinary' staticLink dflags o_files dep_packages = do then ["-Wl,-no_compact_unwind"] else []) - -- '-no_pie' - -- iOS uses 'dynamic-no-pic', so we must pass this to ld to suppress a warning; see #7722 - ++ (if platformOS platform == OSiOS && - not staticLink - then ["-Wl,-no_pie"] - else []) - -- '-Wl,-read_only_relocs,suppress' -- ld gives loads of warnings like: -- ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure @@ -2073,10 +2114,7 @@ linkDynLibCheck dflags o_files dep_packages linkStaticLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO () linkStaticLibCheck dflags o_files dep_packages - = do - when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $ - throwGhcExceptionIO (ProgramError "Static archive creation only supported on Darwin/OS X/iOS") - linkBinary' True dflags o_files dep_packages + = linkBinary' True dflags o_files dep_packages -- ----------------------------------------------------------------------------- -- Running CPP diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index f5f5f00dd2..2cde3b7700 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -76,6 +76,9 @@ module DynFlags ( safeDirectImpsReq, safeImplicitImpsReq, unsafeFlags, unsafeFlagsForInfer, + -- ** LLVM Targets + LlvmTarget(..), LlvmTargets, + -- ** System tool settings and locations Settings(..), targetPlatform, programName, projectVersion, @@ -83,9 +86,9 @@ module DynFlags ( versionedAppDir, extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_lo, pgm_lc, pgm_i, + pgm_windres, pgm_libtool, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_i, - opt_windres, opt_lo, opt_lc, + opt_windres, opt_lo, opt_lc, opt_lcc, -- ** Manipulating DynFlags @@ -407,6 +410,7 @@ data GeneralFlag | Opt_DoAsmLinting | Opt_DoAnnotationLinting | Opt_NoLlvmMangler -- hidden flag + | Opt_FastLlvm -- hidden flag | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_ShowWarnGroups -- Show the group a warning belongs to @@ -695,6 +699,7 @@ data DynFlags = DynFlags { ghcLink :: GhcLink, hscTarget :: HscTarget, settings :: Settings, + llvmTargets :: LlvmTargets, verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] optLevel :: Int, -- ^ Optimisation level debugLevel :: Int, -- ^ How much debug information to produce @@ -999,6 +1004,14 @@ data ProfAuto | ProfAutoCalls -- ^ annotate call-sites deriving (Eq,Enum) +data LlvmTarget = LlvmTarget + { lDataLayout :: String + , lCPU :: String + , lAttributes :: [String] + } + +type LlvmTargets = [(String, LlvmTarget)] + data Settings = Settings { sTargetPlatform :: Platform, -- Filled in by SysTools sGhcUsagePath :: FilePath, -- Filled in by SysTools @@ -1031,6 +1044,7 @@ data Settings = Settings { sPgm_libtool :: String, sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler + sPgm_lcc :: (String,[Option]), -- LLVM: c compiler sPgm_i :: String, -- options for particular phases sOpt_L :: [String], @@ -1042,6 +1056,7 @@ data Settings = Settings { sOpt_windres :: [String], sOpt_lo :: [String], -- LLVM: llvm optimiser sOpt_lc :: [String], -- LLVM: llc static compiler + sOpt_lcc :: [String], -- LLVM: c compiler sOpt_i :: [String], -- iserv options sPlatformConstants :: PlatformConstants @@ -1089,6 +1104,8 @@ pgm_windres :: DynFlags -> String pgm_windres dflags = sPgm_windres (settings dflags) pgm_libtool :: DynFlags -> String pgm_libtool dflags = sPgm_libtool (settings dflags) +pgm_lcc :: DynFlags -> (String,[Option]) +pgm_lcc dflags = sPgm_lcc (settings dflags) pgm_lo :: DynFlags -> (String,[Option]) pgm_lo dflags = sPgm_lo (settings dflags) pgm_lc :: DynFlags -> (String,[Option]) @@ -1112,6 +1129,8 @@ opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags) ++ sOpt_l (settings dflags) opt_windres :: DynFlags -> [String] opt_windres dflags = sOpt_windres (settings dflags) +opt_lcc :: DynFlags -> [String] +opt_lcc dflags = sOpt_lcc (settings dflags) opt_lo :: DynFlags -> [String] opt_lo dflags = sOpt_lo (settings dflags) opt_lc :: DynFlags -> [String] @@ -1547,8 +1566,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 -> DynFlags -defaultDynFlags mySettings = +defaultDynFlags :: Settings -> LlvmTargets -> DynFlags +defaultDynFlags mySettings myLlvmTargets = -- See Note [Updating flag description in the User's Guide] DynFlags { ghcMode = CompManager, @@ -1641,6 +1660,8 @@ defaultDynFlags mySettings = rtsBuildTag = mkBuildTag (defaultWays mySettings), splitInfo = Nothing, settings = mySettings, + llvmTargets = myLlvmTargets, + -- ghc -M values depMakefile = "Makefile", depIncludePkgDeps = False, @@ -3067,6 +3088,8 @@ dynamic_flags_deps = [ (NoArg (setGeneralFlag Opt_D_faststring_stats)) , make_ord_flag defGhcFlag "dno-llvm-mangler" (NoArg (setGeneralFlag Opt_NoLlvmMangler)) -- hidden flag + , make_ord_flag defGhcFlag "fast-llvm" + (NoArg (setGeneralFlag Opt_FastLlvm)) -- hidden flag , make_ord_flag defGhcFlag "ddump-debug" (setDumpFlag Opt_D_dump_debug) , make_ord_flag defGhcFlag "ddump-json" @@ -5244,9 +5267,10 @@ makeDynFlagsConsistent dflags -- initialized. defaultGlobalDynFlags :: DynFlags defaultGlobalDynFlags = - (defaultDynFlags settings) { verbosity = 2 } + (defaultDynFlags settings llvmTargets) { verbosity = 2 } where - settings = panic "v_unsafeGlobalDynFlags: not initialised" + settings = panic "v_unsafeGlobalDynFlags: settings not initialised" + llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised" #if STAGE < 2 GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 8f508411b6..700e4826d1 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -489,7 +489,8 @@ initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir = do { env <- liftIO $ do { mySettings <- initSysTools mb_top_dir - ; dflags <- initDynFlags (defaultDynFlags mySettings) + ; myLlvmTargets <- initLlvmTargets mb_top_dir + ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmTargets) ; checkBrokenTablesNextToCode dflags ; setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 56d2ac5eb9..e16452bca1 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -2578,7 +2578,6 @@ soExt :: Platform -> FilePath soExt platform = case platformOS platform of OSDarwin -> "dylib" - OSiOS -> "dylib" OSMinGW32 -> "dll" _ -> "so" diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index b2d85a782a..61cc24efcf 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -13,6 +13,7 @@ module SysTools ( -- Initialisation initSysTools, + initLlvmTargets, -- Interface to system tools runUnlit, runCpp, runCc, -- [Option] -> IO () @@ -187,6 +188,20 @@ 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) + where + mkLlvmTarget :: (String, String, String) -> LlvmTarget + mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs) + + initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix) -> IO Settings -- Set all the mutable variables above, holding -- (a) the system programs @@ -322,6 +337,7 @@ initSysTools mbMinusB -- We just assume on command line lc_prog <- getSetting "LLVM llc command" lo_prog <- getSetting "LLVM opt command" + lcc_prog <- getSetting "LLVM clang command" let iserv_prog = libexec "ghc-iserv" @@ -365,6 +381,7 @@ initSysTools mbMinusB sPgm_libtool = libtool_path, sPgm_lo = (lo_prog,[]), sPgm_lc = (lc_prog,[]), + sPgm_lcc = (lcc_prog,[]), sPgm_i = iserv_prog, sOpt_L = [], sOpt_P = [], @@ -373,6 +390,7 @@ initSysTools mbMinusB sOpt_a = [], sOpt_l = [], sOpt_windres = [], + sOpt_lcc = [], sOpt_lo = [], sOpt_lc = [], sOpt_i = [], @@ -587,8 +605,7 @@ runLlvmLlc dflags args = do -- assembler) runClang :: DynFlags -> [Option] -> IO () runClang dflags args = do - -- we simply assume its available on the PATH - let clang = "clang" + let (clang,_) = pgm_lcc dflags -- be careful what options we call clang with -- see #5903 and #7617 for bugs caused by this. (_,args0) = pgm_a dflags @@ -818,9 +835,6 @@ getLinkerInfo' dflags = do -- that doesn't support --version. We can just assume that's -- what we're using. return $ DarwinLD [] - OSiOS -> - -- Ditto for iOS - return $ DarwinLD [] OSMinGW32 -> -- GHC doesn't support anything but GNU ld on Windows anyway. -- Process creation is also fairly expensive on win32, so @@ -1666,7 +1680,7 @@ linkDynLib dflags0 o_files dep_packages ++ pkg_lib_path_opts ++ pkg_link_opts )) - OSDarwin -> do + _ | os == OSDarwin -> do ------------------------------------------------------------------- -- Making a darwin dylib ------------------------------------------------------------------- @@ -1726,7 +1740,6 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_link_opts ++ map Option pkg_framework_opts ) - OSiOS -> throwGhcExceptionIO (ProgramError "dynamic libraries are not supported on iOS target") _ -> do ------------------------------------------------------------------- -- Making a DSO |