summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Ericson <git@JohnEricson.me>2019-03-27 00:27:01 -0400
committerBen Gamari <ben@smart-cactus.org>2019-05-14 16:41:19 -0400
commite529c65eacf595006dd5358491d28c202d673732 (patch)
tree0498cb0a7023c491c240d64069e2442073e83d77
parentf9e4ea401121572d799b9db56f24aa1abdf5edf8 (diff)
downloadhaskell-e529c65eacf595006dd5358491d28c202d673732.tar.gz
Remove all target-specific portions of Config.hs
1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim!
-rw-r--r--compiler/cmm/CLabel.hs57
-rw-r--r--compiler/coreSyn/CorePrep.hs1
-rw-r--r--compiler/deSugar/DsForeign.hs3
-rw-r--r--compiler/ghc.mk50
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Base.hs9
-rw-r--r--compiler/main/CodeOutput.hs8
-rw-r--r--compiler/main/DriverPipeline.hs3
-rw-r--r--compiler/main/DynFlags.hs59
-rw-r--r--compiler/main/GhcMake.hs2
-rw-r--r--compiler/main/SysTools.hs47
-rw-r--r--compiler/nativeGen/AsmCodeGen.hs2
-rw-r--r--compiler/nativeGen/PIC.hs48
-rw-r--r--hadrian/src/Rules/Generate.hs130
-rw-r--r--includes/ghc.mk17
14 files changed, 208 insertions, 228 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 81a226d65f..fddb063185 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -120,7 +120,6 @@ import Module
import Name
import Unique
import PrimOp
-import Config
import CostCentre
import Outputable
import FastString
@@ -1151,35 +1150,35 @@ and are not externally visible.
-}
instance Outputable CLabel where
- ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
+ ppr c = sdocWithDynFlags $ \dynFlags -> pprCLabel dynFlags c
-pprCLabel :: Platform -> CLabel -> SDoc
+pprCLabel :: DynFlags -> CLabel -> SDoc
pprCLabel _ (LocalBlockLabel u)
= tempLabelPrefixOrUnderscore <> pprUniqueAlways u
-pprCLabel platform (AsmTempLabel u)
- | not (platformUnregisterised platform)
+pprCLabel dynFlags (AsmTempLabel u)
+ | not (platformUnregisterised $ targetPlatform dynFlags)
= tempLabelPrefixOrUnderscore <> pprUniqueAlways u
-pprCLabel platform (AsmTempDerivedLabel l suf)
- | cGhcWithNativeCodeGen == "YES"
- = ptext (asmTempLabelPrefix platform)
+pprCLabel dynFlags (AsmTempDerivedLabel l suf)
+ | sGhcWithNativeCodeGen $ settings dynFlags
+ = ptext (asmTempLabelPrefix $ targetPlatform dynFlags)
<> case l of AsmTempLabel u -> pprUniqueAlways u
LocalBlockLabel u -> pprUniqueAlways u
- _other -> pprCLabel platform l
+ _other -> pprCLabel dynFlags l
<> ftext suf
-pprCLabel platform (DynamicLinkerLabel info lbl)
- | cGhcWithNativeCodeGen == "YES"
- = pprDynamicLinkerAsmLabel platform info lbl
+pprCLabel dynFlags (DynamicLinkerLabel info lbl)
+ | sGhcWithNativeCodeGen $ settings dynFlags
+ = pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl
-pprCLabel _ PicBaseLabel
- | cGhcWithNativeCodeGen == "YES"
+pprCLabel dynFlags PicBaseLabel
+ | sGhcWithNativeCodeGen $ settings dynFlags
= text "1b"
-pprCLabel platform (DeadStripPreventer lbl)
- | cGhcWithNativeCodeGen == "YES"
+pprCLabel dynFlags (DeadStripPreventer lbl)
+ | sGhcWithNativeCodeGen $ settings dynFlags
=
{-
`lbl` can be temp one but we need to ensure that dsp label will stay
@@ -1187,23 +1186,24 @@ pprCLabel platform (DeadStripPreventer lbl)
optional `_` (underscore) because this is how you mark non-temp symbols
on some platforms (Darwin)
-}
- maybe_underscore $ text "dsp_"
- <> pprCLabel platform lbl <> text "_dsp"
+ maybe_underscore dynFlags $ text "dsp_"
+ <> pprCLabel dynFlags lbl <> text "_dsp"
-pprCLabel _ (StringLitLabel u)
- | cGhcWithNativeCodeGen == "YES"
+pprCLabel dynFlags (StringLitLabel u)
+ | sGhcWithNativeCodeGen $ settings dynFlags
= pprUniqueAlways u <> ptext (sLit "_str")
-pprCLabel platform lbl
+pprCLabel dynFlags lbl
= getPprStyle $ \ sty ->
- if cGhcWithNativeCodeGen == "YES" && asmStyle sty
- then maybe_underscore (pprAsmCLbl platform lbl)
+ if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty
+ then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl
else pprCLbl lbl
-maybe_underscore :: SDoc -> SDoc
-maybe_underscore doc
- | underscorePrefix = pp_cSEP <> doc
- | otherwise = doc
+maybe_underscore :: DynFlags -> SDoc -> SDoc
+maybe_underscore dynFlags doc =
+ if sLeadingUnderscore $ settings dynFlags
+ then pp_cSEP <> doc
+ else doc
pprAsmCLbl :: Platform -> CLabel -> SDoc
pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
@@ -1363,9 +1363,6 @@ tempLabelPrefixOrUnderscore = sdocWithPlatform $ \platform ->
-- -----------------------------------------------------------------------------
-- Machine-dependent knowledge about labels.
-underscorePrefix :: Bool -- leading underscore on assembler labels?
-underscorePrefix = (cLeadingUnderscore == "YES")
-
asmTempLabelPrefix :: Platform -> PtrString -- for formatting labels
asmTempLabelPrefix platform = case platformOS platform of
OSDarwin -> sLit "L"
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index bf6182bc89..e49ffb5973 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -55,7 +55,6 @@ import Pair
import Outputable
import Platform
import FastString
-import Config
import Name ( NamedThing(..), nameSrcSpan )
import SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
import Data.Bits
diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index 95a5e4af14..4df053d845 100644
--- a/compiler/deSugar/DsForeign.hs
+++ b/compiler/deSugar/DsForeign.hs
@@ -50,7 +50,6 @@ import Outputable
import FastString
import DynFlags
import Platform
-import Config
import OrdList
import Pair
import Util
@@ -542,7 +541,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
| otherwise = text ('a':show n)
-- generate a libffi-style stub if this is a "wrapper" and libffi is enabled
- libffi = cLibFFI && isNothing maybe_target
+ libffi = sLibFFI (settings dflags) && isNothing maybe_target
type_string
-- libffi needs to know the result type too:
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 18c3425305..b8c0a1a2fc 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -55,10 +55,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
@echo >> $@
@echo '#include "ghc_boot_platform.h"' >> $@
@echo >> $@
- @echo 'data IntegerLibrary = IntegerGMP' >> $@
- @echo ' | IntegerSimple' >> $@
- @echo ' deriving Eq' >> $@
- @echo >> $@
@echo 'cBuildPlatformString :: String' >> $@
@echo 'cBuildPlatformString = BuildPlatform_NAME' >> $@
@echo 'cHostPlatformString :: String' >> $@
@@ -82,52 +78,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
@echo 'cBooterVersion = "$(GhcVersion)"' >> $@
@echo 'cStage :: String' >> $@
@echo 'cStage = show (STAGE :: Int)' >> $@
- @echo 'cIntegerLibraryType :: IntegerLibrary' >> $@
-ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
- @echo 'cIntegerLibraryType = IntegerGMP' >> $@
-else ifeq "$(INTEGER_LIBRARY)" "integer-simple"
- @echo 'cIntegerLibraryType = IntegerSimple' >> $@
-else ifneq "$(CLEANING)" "YES"
-$(error Unknown integer library)
-endif
- @echo 'cGhcWithInterpreter :: String' >> $@
- @echo 'cGhcWithInterpreter = "$(GhcWithInterpreter)"' >> $@
- @echo 'cGhcWithNativeCodeGen :: String' >> $@
- @echo 'cGhcWithNativeCodeGen = "$(GhcWithNativeCodeGen)"' >> $@
- @echo 'cGhcWithSMP :: String' >> $@
- @echo 'cGhcWithSMP = "$(GhcWithSMP)"' >> $@
- @echo 'cGhcRTSWays :: String' >> $@
- @echo 'cGhcRTSWays = "$(GhcRTSWays)"' >> $@
- @echo 'cGhcRtsWithLibdw :: Bool' >> $@
-ifeq "$(GhcRtsWithLibdw)" "YES"
- @echo 'cGhcRtsWithLibdw = True' >> $@
-else
- @echo 'cGhcRtsWithLibdw = False' >> $@
-endif
- @echo 'cLeadingUnderscore :: String' >> $@
- @echo 'cLeadingUnderscore = "$(LeadingUnderscore)"' >> $@
- @echo 'cLibFFI :: Bool' >> $@
-ifeq "$(UseLibFFIForAdjustors)" "YES"
- @echo 'cLibFFI = True' >> $@
-else
- @echo 'cLibFFI = False' >> $@
-endif
-# Note that GhcThreaded just reflects the Makefile variable setting.
-# In particular, the stage1 compiler is never actually compiled with
-# -threaded, but it will nevertheless have cGhcThreaded = True.
-# The "+RTS --info" output will show what RTS GHC is really using.
- @echo 'cGhcThreaded :: Bool' >> $@
-ifeq "$(GhcThreaded)" "YES"
- @echo 'cGhcThreaded = True' >> $@
-else
- @echo 'cGhcThreaded = False' >> $@
-endif
- @echo 'cGhcDebugged :: Bool' >> $@
-ifeq "$(GhcDebugged)" "YES"
- @echo 'cGhcDebugged = True' >> $@
-else
- @echo 'cGhcDebugged = False' >> $@
-endif
@echo done.
# -----------------------------------------------------------------------------
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 15101c82ee..d55c339888 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -390,17 +390,15 @@ ghcInternalFunctions = do
-- | Pretty print a 'CLabel'.
strCLabel_llvm :: CLabel -> LlvmM LMString
strCLabel_llvm lbl = do
- platform <- getLlvmPlatform
dflags <- getDynFlags
- let sdoc = pprCLabel platform lbl
+ let sdoc = pprCLabel dflags lbl
str = Outp.renderWithStyle dflags sdoc (Outp.mkCodeStyle Outp.CStyle)
return (fsLit str)
strDisplayName_llvm :: CLabel -> LlvmM LMString
strDisplayName_llvm lbl = do
- platform <- getLlvmPlatform
dflags <- getDynFlags
- let sdoc = pprCLabel platform lbl
+ let sdoc = pprCLabel dflags lbl
depth = Outp.PartWay 1
style = Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth
str = Outp.renderWithStyle dflags sdoc style
@@ -416,9 +414,8 @@ dropInfoSuffix = go
strProcedureName_llvm :: CLabel -> LlvmM LMString
strProcedureName_llvm lbl = do
- platform <- getLlvmPlatform
dflags <- getDynFlags
- let sdoc = pprCLabel platform lbl
+ let sdoc = pprCLabel dflags lbl
depth = Outp.PartWay 1
style = Outp.mkUserStyle dflags Outp.neverQualify depth
str = Outp.renderWithStyle dflags sdoc style
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
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index c78ea5fcb1..2d0bf30b5e 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -852,7 +852,7 @@ makeImportsDoc dflags imports
| otherwise
= Outputable.empty
- doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel platform lbl) astyle)
+ doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel dflags lbl) astyle)
astyle = mkCodeStyle AsmStyle
-- -----------------------------------------------------------------------------
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index b4bf8998d1..69113e8ea5 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -565,19 +565,19 @@ pprGotDeclaration _ _ _
--
pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
-pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
+pprImportedSymbol dflags (Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case positionIndependent dflags of
False ->
vcat [
text ".symbol_stub",
- text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
- text "\t.indirect_symbol" <+> pprCLabel platform lbl,
- text "\tjmp *L" <> pprCLabel platform lbl
+ text "L" <> pprCLabel dflags lbl <> ptext (sLit "$stub:"),
+ text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
+ text "\tjmp *L" <> pprCLabel dflags lbl
<> text "$lazy_ptr",
- text "L" <> pprCLabel platform lbl
+ text "L" <> pprCLabel dflags lbl
<> text "$stub_binder:",
- text "\tpushl $L" <> pprCLabel platform lbl
+ text "\tpushl $L" <> pprCLabel dflags lbl
<> text "$lazy_ptr",
text "\tjmp dyld_stub_binding_helper"
]
@@ -585,16 +585,16 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS
vcat [
text ".section __TEXT,__picsymbolstub2,"
<> text "symbol_stubs,pure_instructions,25",
- text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
- text "\t.indirect_symbol" <+> pprCLabel platform lbl,
+ text "L" <> pprCLabel dflags lbl <> ptext (sLit "$stub:"),
+ text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
text "\tcall ___i686.get_pc_thunk.ax",
text "1:",
- text "\tmovl L" <> pprCLabel platform lbl
+ text "\tmovl L" <> pprCLabel dflags lbl
<> text "$lazy_ptr-1b(%eax),%edx",
text "\tjmp *%edx",
- text "L" <> pprCLabel platform lbl
+ text "L" <> pprCLabel dflags lbl
<> text "$stub_binder:",
- text "\tlea L" <> pprCLabel platform lbl
+ text "\tlea L" <> pprCLabel dflags lbl
<> text "$lazy_ptr-1b(%eax),%eax",
text "\tpushl %eax",
text "\tjmp dyld_stub_binding_helper"
@@ -602,16 +602,16 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS
$+$ vcat [ text ".section __DATA, __la_sym_ptr"
<> (if positionIndependent dflags then int 2 else int 3)
<> text ",lazy_symbol_pointers",
- text "L" <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
- text "\t.indirect_symbol" <+> pprCLabel platform lbl,
- text "\t.long L" <> pprCLabel platform lbl
+ text "L" <> pprCLabel dflags lbl <> ptext (sLit "$lazy_ptr:"),
+ text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
+ text "\t.long L" <> pprCLabel dflags lbl
<> text "$stub_binder"]
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
text ".non_lazy_symbol_pointer",
- char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr:",
- text "\t.indirect_symbol" <+> pprCLabel platform lbl,
+ char 'L' <> pprCLabel dflags lbl <> text "$non_lazy_ptr:",
+ text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
text "\t.long\t0"]
| otherwise
@@ -632,12 +632,12 @@ pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
--
-- NB: No DSO-support yet
-pprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl
+pprImportedSymbol dflags (Platform { platformOS = OSAIX }) importedLbl
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> vcat [
- text "LC.." <> pprCLabel platform lbl <> char ':',
- text "\t.long" <+> pprCLabel platform lbl ]
+ text "LC.." <> pprCLabel dflags lbl <> char ':',
+ text "\t.long" <+> pprCLabel dflags lbl ]
_ -> empty
-- ELF / Linux
@@ -669,15 +669,15 @@ pprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl
-- the NCG will keep track of all DynamicLinkerLabels it uses
-- and output each of them using pprImportedSymbol.
-pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 _ })
+pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC_64 _ })
importedLbl
| osElfTarget (platformOS platform)
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> vcat [
text ".section \".toc\", \"aw\"",
- text ".LC_" <> pprCLabel platform lbl <> char ':',
- text "\t.quad" <+> pprCLabel platform lbl ]
+ text ".LC_" <> pprCLabel dflags lbl <> char ':',
+ text "\t.quad" <+> pprCLabel dflags lbl ]
_ -> empty
pprImportedSymbol dflags platform importedLbl
@@ -691,8 +691,8 @@ pprImportedSymbol dflags platform importedLbl
in vcat [
text ".section \".got2\", \"aw\"",
- text ".LC_" <> pprCLabel platform lbl <> char ':',
- ptext symbolSize <+> pprCLabel platform lbl ]
+ text ".LC_" <> pprCLabel dflags lbl <> char ':',
+ ptext symbolSize <+> pprCLabel dflags lbl ]
-- PLT code stubs are generated automatically by the dynamic linker.
_ -> empty
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index 0787978938..2538e76c0a 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -271,47 +271,54 @@ generateGhcPlatformH = do
generateSettings :: Expr String
generateSettings = do
- let flag' = flag >=> \case
- True -> pure "YES"
- False -> pure "NO"
- settings <- (traverse . traverse) expr $
- [ ("GCC extra via C opts", lookupValueOrError configFile "gcc-extra-via-c-opts")
- , ("C compiler command", settingsFileSetting SettingsFileSetting_CCompilerCommand)
- , ("C compiler flags", settingsFileSetting SettingsFileSetting_CCompilerFlags)
- , ("C compiler link flags", settingsFileSetting SettingsFileSetting_CCompilerLinkFlags)
- , ("C compiler supports -no-pie", settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie)
- , ("Haskell CPP command", settingsFileSetting SettingsFileSetting_HaskellCPPCommand)
- , ("Haskell CPP flags", settingsFileSetting SettingsFileSetting_HaskellCPPFlags)
- , ("ld command", settingsFileSetting SettingsFileSetting_LdCommand)
- , ("ld flags", settingsFileSetting SettingsFileSetting_LdFlags)
- , ("ld supports compact unwind", lookupValueOrError configFile "ld-has-no-compact-unwind")
- , ("ld supports build-id", lookupValueOrError configFile "ld-has-build-id")
- , ("ld supports filelist", lookupValueOrError configFile "ld-has-filelist")
- , ("ld is GNU ld", lookupValueOrError configFile "ld-is-gnu-ld")
- , ("ar command", settingsFileSetting SettingsFileSetting_ArCommand)
- , ("ar flags", lookupValueOrError configFile "ar-args")
- , ("ar supports at file", flag' ArSupportsAtFile)
- , ("ranlib command", settingsFileSetting SettingsFileSetting_RanlibCommand)
- , ("touch command", settingsFileSetting SettingsFileSetting_TouchCommand)
- , ("dllwrap command", settingsFileSetting SettingsFileSetting_DllWrapCommand)
- , ("windres command", settingsFileSetting SettingsFileSetting_WindresCommand)
- , ("libtool command", settingsFileSetting SettingsFileSetting_LibtoolCommand)
- , ("unlit command", ("$topdir/bin/" <>) . takeFileName <$> builderPath Unlit)
- , ("cross compiling", flag' CrossCompiling)
- , ("target platform string", setting TargetPlatform)
- , ("target os", lookupValueOrError configFile "haskell-target-os")
- , ("target arch", lookupValueOrError configFile "haskell-target-arch")
- , ("target word size", lookupValueOrError configFile "target-word-size")
- , ("target has GNU nonexec stack", lookupValueOrError configFile "haskell-have-gnu-nonexec-stack")
- , ("target has .ident directive", lookupValueOrError configFile "haskell-have-ident-directive")
- , ("target has subsections via symbols", lookupValueOrError configFile "haskell-have-subsections-via-symbols")
- , ("target has RTS linker", lookupValueOrError configFile "haskell-have-rts-linker")
- , ("Unregisterised", flag' GhcUnregisterised)
- , ("LLVM llc command", settingsFileSetting SettingsFileSetting_LlcCommand)
- , ("LLVM opt command", settingsFileSetting SettingsFileSetting_OptCommand)
- , ("LLVM clang command", settingsFileSetting SettingsFileSetting_ClangCommand)
-
- , ("Tables next to code", yesNo <$> ghcEnableTablesNextToCode)
+ settings <- traverse sequence $
+ [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts")
+ , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand)
+ , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags)
+ , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags)
+ , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie)
+ , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand)
+ , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags)
+ , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand)
+ , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags)
+ , ("ld supports compact unwind", expr $ lookupValueOrError configFile "ld-has-no-compact-unwind")
+ , ("ld supports build-id", expr $ lookupValueOrError configFile "ld-has-build-id")
+ , ("ld supports filelist", expr $ lookupValueOrError configFile "ld-has-filelist")
+ , ("ld is GNU ld", expr $ lookupValueOrError configFile "ld-is-gnu-ld")
+ , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand)
+ , ("ar flags", expr $ lookupValueOrError configFile "ar-args")
+ , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile)
+ , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand)
+ , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand)
+ , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand)
+ , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand)
+ , ("libtool command", expr $ settingsFileSetting SettingsFileSetting_LibtoolCommand)
+ , ("unlit command", ("$topdir/bin/" <>) <$> getBuilderPath Unlit)
+ , ("cross compiling", expr $ yesNo <$> flag CrossCompiling)
+ , ("target platform string", getSetting TargetPlatform)
+ , ("target os", expr $ lookupValueOrError configFile "haskell-target-os")
+ , ("target arch", expr $ lookupValueOrError configFile "haskell-target-arch")
+ , ("target word size", expr $ lookupValueOrError configFile "target-word-size")
+ , ("target has GNU nonexec stack", expr $ lookupValueOrError configFile "haskell-have-gnu-nonexec-stack")
+ , ("target has .ident directive", expr $ lookupValueOrError configFile "haskell-have-ident-directive")
+ , ("target has subsections via symbols", expr $ lookupValueOrError configFile "haskell-have-subsections-via-symbols")
+ , ("target has RTS linker", expr $ lookupValueOrError configFile "haskell-have-rts-linker")
+ , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised)
+ , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand)
+ , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand)
+ , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand)
+
+ , ("integer library", pkgName <$> getIntegerPackage)
+ , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter)
+ , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen)
+ , ("Support SMP", expr $ yesNo <$> ghcWithSMP)
+ , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore)
+ , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode)
+ , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors)
+ , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors)
+ , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays)
+ , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour)
+ , ("RTS expects libdw", yesNo <$> getFlag WithLibdw)
]
let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
pure $ case settings of
@@ -334,20 +341,6 @@ generateConfigHs = do
cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
cBooterVersion <- getSetting GhcVersion
- intLib <- getIntegerPackage
- debugged <- ghcDebugged <$> expr flavour
- let cIntegerLibraryType
- | intLib == integerGmp = "IntegerGMP"
- | intLib == integerSimple = "IntegerSimple"
- | otherwise = error $ "Unknown integer library: " ++ pkgName intLib
- cGhcWithInterpreter <- expr $ yesNo <$> ghcWithInterpreter
- cGhcWithNativeCodeGen <- expr $ yesNo <$> ghcWithNativeCodeGen
- cGhcWithSMP <- expr $ yesNo <$> ghcWithSMP
- cLeadingUnderscore <- expr $ yesNo <$> flag LeadingUnderscore
- cLibFFI <- expr useLibFFIForAdjustors
- rtsWays <- getRtsWays
- cGhcRtsWithLibdw <- getFlag WithLibdw
- let cGhcRTSWays = unwords $ map show rtsWays
return $ unlines
[ "{-# LANGUAGE CPP #-}"
, "module Config where"
@@ -356,10 +349,6 @@ generateConfigHs = do
, ""
, "#include \"ghc_boot_platform.h\""
, ""
- , "data IntegerLibrary = IntegerGMP"
- , " | IntegerSimple"
- , " deriving Eq"
- , ""
, "cBuildPlatformString :: String"
, "cBuildPlatformString = BuildPlatform_NAME"
, "cHostPlatformString :: String"
@@ -383,28 +372,7 @@ generateConfigHs = do
, "cBooterVersion = " ++ show cBooterVersion
, "cStage :: String"
, "cStage = show (STAGE :: Int)"
- , "cIntegerLibrary :: String"
- , "cIntegerLibrary = " ++ show (pkgName intLib)
- , "cIntegerLibraryType :: IntegerLibrary"
- , "cIntegerLibraryType = " ++ cIntegerLibraryType
- , "cGhcWithInterpreter :: String"
- , "cGhcWithInterpreter = " ++ show cGhcWithInterpreter
- , "cGhcWithNativeCodeGen :: String"
- , "cGhcWithNativeCodeGen = " ++ show cGhcWithNativeCodeGen
- , "cGhcWithSMP :: String"
- , "cGhcWithSMP = " ++ show cGhcWithSMP
- , "cGhcRTSWays :: String"
- , "cGhcRTSWays = " ++ show cGhcRTSWays
- , "cLeadingUnderscore :: String"
- , "cLeadingUnderscore = " ++ show cLeadingUnderscore
- , "cLibFFI :: Bool"
- , "cLibFFI = " ++ show cLibFFI
- , "cGhcThreaded :: Bool"
- , "cGhcThreaded = " ++ show (any (wayUnit Threaded) rtsWays)
- , "cGhcDebugged :: Bool"
- , "cGhcDebugged = " ++ show debugged
- , "cGhcRtsWithLibdw :: Bool"
- , "cGhcRtsWithLibdw = " ++ show cGhcRtsWithLibdw ]
+ ]
-- | Generate @ghcautoconf.h@ header.
generateGhcAutoconfH :: Expr String
diff --git a/includes/ghc.mk b/includes/ghc.mk
index 71941c9d50..2421d9ca96 100644
--- a/includes/ghc.mk
+++ b/includes/ghc.mk
@@ -211,8 +211,23 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/.
@echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@
@echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@
@echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@
+ @echo
+ @echo ',("integer library", "$(INTEGER_LIBRARY)")' >> $@
+ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@
+ @echo ',("Use native code generator", "$(GhcWithNativeCodeGen)")' >> $@
+ @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@
+ @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@
@echo ',("Tables next to code", "$(GhcEnableTablesNextToCode)")' >> $@
- @echo ']' >> $@
+ @echo ',("Leading underscore", "$(LeadingUnderscore)")' >> $@
+ @echo ',("Use LibFFI", "$(UseLibFFIForAdjustors)")' >> $@
+# Note that GhcThreaded just reflects the Makefile variable setting. In
+# particular, the stage1 compiler is never actually compiled with -threaded, but
+# it will nevertheless have cGhcThreaded = True. The "+RTS --info" output will
+# show what RTS GHC is really using.
+ @echo ",(\"Use Threads\", \"$(GhcThreaded)\")" >> $@
+ @echo ",(\"Use Debugging\", \"$(GhcDebugged)\")" >> $@
+ @echo ",(\"RTS expects libdw\", \"$(GhcRtsWithLibdw)\")" >> $@
+ @echo "]" >> $@
# ---------------------------------------------------------------------------