Commit e529c65e authored by John Ericson's avatar John Ericson Committed by Ben Gamari

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!
parent f9e4ea40
......@@ -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"
......
......@@ -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
......
......@@ -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:
......
......@@ -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.
# -----------------------------------------------------------------------------
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
-- -----------------------------------------------------------------------------
......
......@@ -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
......
......@@ -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_HaskellCPPFlag