diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/CodeOutput.hs | 8 | ||||
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 3 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 59 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 2 | ||||
| -rw-r--r-- | compiler/main/SysTools.hs | 47 |
5 files changed, 87 insertions, 32 deletions
diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs index 478de594ac..1ded72111a 100644 --- a/compiler/main/CodeOutput.hs +++ b/compiler/main/CodeOutput.hs @@ -24,7 +24,6 @@ import Packages import Cmm ( RawCmmGroup ) import HscTypes import DynFlags -import Config import Stream (Stream) import qualified Stream import FileCleanup @@ -156,7 +155,7 @@ outputAsm :: DynFlags -> Module -> ModLocation -> FilePath -> Stream IO RawCmmGroup () -> IO () outputAsm dflags this_mod location filenm cmm_stream - | cGhcWithNativeCodeGen == "YES" + | sGhcWithNativeCodeGen $ settings dflags = do ncg_uniqs <- mkSplitUniqSupply 'n' debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm) @@ -226,8 +225,9 @@ outputForeignStubs dflags mod location stubs mk_include i = "#include \"" ++ i ++ "\"\n" -- wrapper code mentions the ffi_arg type, which comes from ffi.h - ffi_includes | cLibFFI = "#include \"ffi.h\"\n" - | otherwise = "" + ffi_includes + | sLibFFI $ settings dflags = "#include \"ffi.h\"\n" + | otherwise = "" stub_h_file_exists <- outputForeignStubs_help stub_h stub_h_output_w diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 82a6d601de..d22462388e 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -49,7 +49,6 @@ import Outputable import Module import ErrUtils import DynFlags -import Config import Panic import Util import StringBuffer ( hGetStringBuffer ) @@ -369,7 +368,7 @@ link ghcLink dflags = lookupHook linkHook l dflags ghcLink dflags where l LinkInMemory _ _ _ - = if cGhcWithInterpreter == "YES" + = if sGhcWithInterpreter $ settings dflags then -- Not Linking...(demand linker will do the job) return Succeeded else panicBadLink LinkInMemory diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index ece0c2208e..d40a9aba36 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -87,6 +87,7 @@ module DynFlags ( -- ** System tool settings and locations Settings(..), + IntegerLibrary(..), targetPlatform, programName, projectVersion, ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, versionedAppDir, @@ -1302,6 +1303,11 @@ type LlvmTargets = [(String, LlvmTarget)] type LlvmPasses = [(Int, String)] type LlvmConfig = (LlvmTargets, LlvmPasses) +data IntegerLibrary + = IntegerGMP + | IntegerSimple + deriving (Read, Show, Eq) + data Settings = Settings { sTargetPlatform :: Platform, -- Filled in by SysTools sGhcUsagePath :: FilePath, -- ditto @@ -1358,7 +1364,18 @@ data Settings = Settings { -- Formerly Config.hs, target specific sTargetPlatformString :: String, -- TODO Recalculate string from richer info? - sTablesNextToCode :: Bool + sIntegerLibrary :: String, + sIntegerLibraryType :: IntegerLibrary, + sGhcWithInterpreter :: Bool, + sGhcWithNativeCodeGen :: Bool, + sGhcWithSMP :: Bool, + sGhcRTSWays :: String, + sTablesNextToCode :: Bool, + sLeadingUnderscore :: Bool, + sLibFFI :: Bool, + sGhcThreaded :: Bool, + sGhcDebugged :: Bool, + sGhcRtsWithLibdw :: Bool } targetPlatform :: DynFlags -> Platform @@ -1615,16 +1632,18 @@ instance Outputable PackageFlag where ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) ppr (HidePackage str) = text "-hide-package" <+> text str -defaultHscTarget :: Platform -> HscTarget +defaultHscTarget :: Settings -> HscTarget defaultHscTarget = defaultObjectTarget -- | The 'HscTarget' value corresponding to the default way to create -- object files on the current platform. -defaultObjectTarget :: Platform -> HscTarget -defaultObjectTarget platform +defaultObjectTarget :: Settings -> HscTarget +defaultObjectTarget settings | platformUnregisterised platform = HscC - | cGhcWithNativeCodeGen == "YES" = HscAsm + | sGhcWithNativeCodeGen settings = HscAsm | otherwise = HscLlvm + where + platform = sTargetPlatform settings -- Determines whether we will be compiling -- info tables that reside just before the entry code, or with an @@ -1887,8 +1906,8 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = DynFlags { ghcMode = CompManager, ghcLink = LinkBinary, - hscTarget = defaultHscTarget (sTargetPlatform mySettings), - integerLibrary = cIntegerLibraryType, + hscTarget = defaultHscTarget mySettings, + integerLibrary = sIntegerLibraryType mySettings, verbosity = 0, optLevel = 0, debugLevel = 0, @@ -3704,7 +3723,7 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> d { ghcLink=NoLink }) >> setTarget HscNothing)) , make_ord_flag defFlag "fbyte-code" (NoArg (setTarget HscInterpreted)) - , make_ord_flag defFlag "fobject-code" (NoArg (setTargetWithPlatform + , make_ord_flag defFlag "fobject-code" (NoArg (setTargetWithSettings defaultHscTarget)) , make_dep_flag defFlag "fglasgow-exts" (NoArg enableGlasgowExts) "Use individual extensions instead" @@ -5386,12 +5405,12 @@ interpretPackageEnv dflags = do -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). setTarget :: HscTarget -> DynP () -setTarget l = setTargetWithPlatform (const l) +setTarget l = setTargetWithSettings (const l) -setTargetWithPlatform :: (Platform -> HscTarget) -> DynP () -setTargetWithPlatform f = upd set +setTargetWithSettings :: (Settings -> HscTarget) -> DynP () +setTargetWithSettings f = upd set where - set dfs = let l = f (targetPlatform dfs) + set dfs = let l = f (settings dfs) in if ghcLink dfs /= LinkBinary || isObjectTarget l then dfs{ hscTarget = l } else dfs @@ -5623,13 +5642,13 @@ compilerInfo dflags ("Build platform", cBuildPlatformString), ("Host platform", cHostPlatformString), ("Target platform", sTargetPlatformString $ settings dflags), - ("Have interpreter", cGhcWithInterpreter), + ("Have interpreter", showBool $ sGhcWithInterpreter $ settings dflags), ("Object splitting supported", showBool False), - ("Have native code generator", cGhcWithNativeCodeGen), - ("Support SMP", cGhcWithSMP), + ("Have native code generator", showBool $ sGhcWithNativeCodeGen $ settings dflags), + ("Support SMP", showBool $ sGhcWithSMP $ settings dflags), ("Tables next to code", showBool $ sTablesNextToCode $ settings dflags), - ("RTS ways", cGhcRTSWays), - ("RTS expects libdw", showBool cGhcRtsWithLibdw), + ("RTS ways", sGhcRTSWays $ settings dflags), + ("RTS expects libdw", showBool $ sGhcRtsWithLibdw $ settings dflags), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make@. @@ -5656,7 +5675,7 @@ compilerInfo dflags ("GHC Dynamic", showBool dynamicGhc), -- Whether or not GHC was compiled using -prof ("GHC Profiled", showBool rtsIsProfiled), - ("Leading underscore", cLeadingUnderscore), + ("Leading underscore", showBool $ sLeadingUnderscore $ settings dflags), ("Debug on", show debugIsOn), ("LibDir", topDir dflags), -- The path of the global package database used by GHC @@ -5747,7 +5766,7 @@ makeDynFlagsConsistent dflags in loop dflags' warn | hscTarget dflags == HscC && not (platformUnregisterised (targetPlatform dflags)) - = if cGhcWithNativeCodeGen == "YES" + = if sGhcWithNativeCodeGen $ settings dflags then let dflags' = dflags { hscTarget = HscAsm } warn = "Compiler not unregisterised, so using native code generator rather than compiling via C" in loop dflags' warn @@ -5763,7 +5782,7 @@ makeDynFlagsConsistent dflags = loop (dflags { hscTarget = HscC }) "Compiler unregisterised, so compiling via C" | hscTarget dflags == HscAsm && - cGhcWithNativeCodeGen /= "YES" + not (sGhcWithNativeCodeGen $ settings dflags) = let dflags' = dflags { hscTarget = HscLlvm } warn = "No native code generator, so using LLVM" in loop dflags' warn diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index d730fe70f1..fe4c9781e2 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1953,7 +1953,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- See Note [-fno-code mode] #8025 map1 <- if hscTarget dflags == HscNothing then enableCodeGenForTH - (defaultObjectTarget (targetPlatform dflags)) + (defaultObjectTarget (settings dflags)) map0 else return map0 return $ concat $ nodeMapElts map1 diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 50cc6d58e5..b3dc60654e 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -259,6 +259,29 @@ initSysTools top_dir platformIsCrossCompiling = crossCompiling } + integerLibrary <- getSetting "integer library" + integerLibraryType <- case integerLibrary of + "integer-gmp" -> pure IntegerGMP + "integer-simple" -> pure IntegerSimple + _ -> pgmError $ unwords + [ "Entry for" + , show "integer library" + , "must be one of" + , show "integer-gmp" + , "or" + , show "integer-simple" + ] + + ghcWithInterpreter <- getBooleanSetting "Use interpreter" + ghcWithNativeCodeGen <- getBooleanSetting "Use native code generator" + ghcWithSMP <- getBooleanSetting "Support SMP" + ghcRTSWays <- getSetting "RTS ways" + leadingUnderscore <- getBooleanSetting "Leading underscore" + useLibFFI <- getBooleanSetting "Use LibFFI" + ghcThreaded <- getBooleanSetting "Use Threads" + ghcDebugged <- getBooleanSetting "Use Debugging" + ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw" + return $ Settings { sTargetPlatform = platform, sTmpDir = normalise tmpdir, @@ -306,8 +329,20 @@ initSysTools top_dir sOpt_lc = [], sOpt_i = [], sPlatformConstants = platformConstants, + sTargetPlatformString = targetPlatformString, - sTablesNextToCode = tablesNextToCode + sIntegerLibrary = integerLibrary, + sIntegerLibraryType = integerLibraryType, + sGhcWithInterpreter = ghcWithInterpreter, + sGhcWithNativeCodeGen = ghcWithNativeCodeGen, + sGhcWithSMP = ghcWithSMP, + sGhcRTSWays = ghcRTSWays, + sTablesNextToCode = tablesNextToCode, + sLeadingUnderscore = leadingUnderscore, + sLibFFI = useLibFFI, + sGhcThreaded = ghcThreaded, + sGhcDebugged = ghcDebugged, + sGhcRtsWithLibdw = ghcRtsWithLibdw } @@ -383,10 +418,12 @@ linkDynLib dflags0 o_files dep_packages -- against libHSrts, then both end up getting loaded, -- and things go wrong. We therefore link the libraries -- with the same RTS flags that we link GHC with. - dflags1 = if cGhcThreaded then addWay' WayThreaded dflags0 - else dflags0 - dflags2 = if cGhcDebugged then addWay' WayDebug dflags1 - else dflags1 + dflags1 = if sGhcThreaded $ settings dflags0 + then addWay' WayThreaded dflags0 + else dflags0 + dflags2 = if sGhcDebugged $ settings dflags1 + then addWay' WayDebug dflags1 + else dflags1 dflags = updateWays dflags2 verbFlags = getVerbFlags dflags |