[Git][ghc/ghc][wip/toolchain-selection] 2 commits: FixeWs
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Wed Jul 5 14:55:40 UTC 2023
Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC
Commits:
72264bb6 by Rodrigo Mesquita at 2023-07-05T15:13:15+01:00
FixeWs
Fixes2
- - - - -
465d92b1 by Rodrigo Mesquita at 2023-07-05T15:55:24+01:00
Try to add locally-executable arg
- - - - -
13 changed files:
- TODO
- default.target.in
- hadrian/src/Builder.hs
- hadrian/src/Context.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Settings/Builders/Cabal.hs
- m4/ghc_toolchain.m4
- m4/prep_target_file.m4
- utils/ghc-toolchain/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
Changes:
=====================================
TODO
=====================================
@@ -1,2 +1,6 @@
+Things that might get done on this or another MR
+[ ] Guarantee flags passed to configure are eventually passed to ghc-toolchain (like CFLAGS=...) explicitly specified
+[ ] Drop SettingsXXXX altogether, now we just have the toolchain (well, this goes with deleting a good part of configure)
+[ ] Readelf is only used to find cc link, that OK?
[ ] In hadrian/src/Rules/Generate.hs, generateGhcPlatformH, factor out the query into an argument to chooseSetting, to deduplicate it
[ ] Get rid of all the ToolchainSettings in Hadrian still (e.g. settings-clang-command)
=====================================
default.target.in
=====================================
@@ -1,6 +1,7 @@
Target
-{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@}
-, tgtVendor = @HostVendor_CPPMaybeStr@
+{ tgtArchOs = ArchOS {archOS_arch = @HaskellTargetArch@, archOS_OS = @HaskellTargetOs@}
+, tgtVendor = @TargetVendor_CPPMaybeStr@
+, tgtLocallyExecutable = Just @NotCrossCompilingBool@
, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@
, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@
, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@
@@ -11,9 +12,9 @@ Target
, tgtUnregisterised = @UnregisterisedBool@
, tgtTablesNextToCode = @TablesNextToCodeBool@
, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@
-, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}}
-, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}}
-, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @SettingsCPPFlagsList@}}
+, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @CFLAGSList@}}
+, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @CXXFLAGSList@}}
+, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @CPPFLAGSList@}}
, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@SettingsHaskellCPPCommand@", prgFlags = @SettingsHaskellCPPFlagsList@}}
, tgtCCompilerLink = CcLink
{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@}
@@ -34,6 +35,6 @@ Target
, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@SettingsRanlibCommand@", prgFlags = []}})
, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}}
, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}, mergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFilesBool@})
-, tgtDllwrap = @SettingsDllWrapCommandMaybeProg@
-, tgtWindres = @SettingsWindresCommandMaybeProg@
+, tgtDllwrap = @DllWrapCmdMaybeProg@
+, tgtWindres = @WindresCmdMaybeProg@
}
=====================================
hadrian/src/Builder.hs
=====================================
@@ -28,7 +28,7 @@ import Hadrian.Builder.Tar
import Hadrian.Oracles.Path
import Hadrian.Oracles.TextFile
import Hadrian.Utilities
-import Oracles.Setting (bashPath)
+import Oracles.Setting (bashPath,targetStage)
import System.Exit
import System.IO (stderr)
@@ -423,11 +423,9 @@ isOptional target = \case
systemBuilderPath :: Builder -> Action FilePath
systemBuilderPath builder = case builder of
Alex -> fromKey "alex"
- Ar _ (Stage0 {})-> fromHostTC "system-ar" (Toolchain.arMkArchive . tgtAr)
- Ar _ _ -> fromTargetTC "ar" (Toolchain.arMkArchive . tgtAr)
+ Ar _ stage -> fromStageTC stage "ar" (Toolchain.arMkArchive . tgtAr)
Autoreconf _ -> stripExe =<< fromKey "autoreconf"
- Cc _ (Stage0 {}) -> fromHostTC "system-cc" (Toolchain.ccProgram . tgtCCompiler)
- Cc _ _ -> fromTargetTC "cc" (Toolchain.ccProgram . tgtCCompiler)
+ Cc _ stage -> fromStageTC stage "cc" (Toolchain.ccProgram . tgtCCompiler)
-- We can't ask configure for the path to configure!
Configure _ -> return "configure"
Ghc _ (Stage0 {}) -> fromKey "system-ghc"
@@ -443,8 +441,7 @@ systemBuilderPath builder = case builder of
-- parameters. E.g. building a cross-compiler on and for x86_64
-- which will target ppc64 means that MergeObjects Stage0 will use
-- x86_64 linker and MergeObject _ will use ppc64 linker.
- MergeObjects (Stage0 {}) -> fromHostTC "system-merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs)
- MergeObjects _ -> fromTargetTC "merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs)
+ MergeObjects st -> fromStageTC st "merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs)
Make _ -> fromKey "make"
Makeinfo -> fromKey "makeinfo"
Nm -> fromTargetTC "nm" (Toolchain.nmProgram . tgtNm)
@@ -469,9 +466,9 @@ systemBuilderPath builder = case builder of
path <- unpack <$> lookupValue configFile key
validate key path
- -- Get program from the host's target configuration
- fromHostTC keyname key = do
- path <- queryHostTarget (prgPath . key)
+ -- Get program from a certain stage's target configuration
+ fromStageTC stage keyname key = do
+ path <- prgPath . key <$> targetStage stage
validate keyname path
-- Get program from the target's target configuration
=====================================
hadrian/src/Context.hs
=====================================
@@ -20,7 +20,6 @@ import Hadrian.Expression
import Hadrian.Haskell.Cabal
import Oracles.Setting
import GHC.Toolchain.Target (Target(..))
-import Hadrian.Oracles.TextFile
import GHC.Platform.ArchOS
-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
@@ -65,12 +64,9 @@ libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib"))
-- conventions (see 'cabalOsString' and 'cabalArchString').
distDir :: Stage -> Action FilePath
distDir st = do
- let queryStageTarget = case st of
- Stage0 {} -> queryBuildTarget
- _ -> queryHostTarget
version <- ghcVersionStage st
- hostOs <- cabalOsString <$> queryStageTarget (stringEncodeOS . archOS_OS . tgtArchOs)
- hostArch <- cabalArchString <$> queryStageTarget (stringEncodeArch . archOS_arch . tgtArchOs)
+ hostOs <- cabalOsString . stringEncodeOS . archOS_OS . tgtArchOs <$> targetStage st
+ hostArch <- cabalArchString . stringEncodeArch . archOS_arch . tgtArchOs <$> targetStage st
return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
pkgFileName :: Context -> Package -> String -> String -> Action FilePath
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -82,6 +82,8 @@ data Setting = CursesIncludeDir
-- This used to be defined by 'FP_SETTINGS' in aclocal.m4.
--
-- TODO: We should be able to drop this completely, after moving all the toolchain settings to ghc-toolchain
+--
+-- TODO: For the next person, move to ghc-toolchain and to the Target files generated by configure and ghc-toolchain
data ToolchainSetting
= ToolchainSetting_OtoolCommand
| ToolchainSetting_InstallNameToolCommand
@@ -259,10 +261,11 @@ libsuf st way
return (suffix ++ "-ghc" ++ version ++ extension)
targetStage :: Stage -> Action Target
--- ROMES:TODO: First iteration, only make it work for BUILD=HOST=TARGET
--- What are the correct targets here?
+-- TODO: We currently only support cross-compiling a stage1 compiler,
+-- but the cross compiler should really be stage2 (#19174)
+-- When we get there, we'll need to change the definition here.
targetStage (Stage0 {}) = getBuildTarget
targetStage (Stage1 {}) = getHostTarget
-targetStage (Stage2 {}) = getHostTarget
+targetStage (Stage2 {}) = getTargetTarget
targetStage (Stage3 {}) = getTargetTarget
=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -204,6 +204,7 @@ configureArgs cFlags' ldFlags' = do
, conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir
, conf "--with-gmp-libraries" $ arg =<< getSetting GmpLibDir
, conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir
+ -- ROMES:TODO: how is the Host set to TargetPlatformFull? That would be the target
, conf "--host" $ arg =<< getSetting TargetPlatformFull
, conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage
, notStage0 ? arg "--ghc-option=-ghcversion-file=rts/include/ghcversion.h"
=====================================
m4/ghc_toolchain.m4
=====================================
@@ -17,6 +17,15 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG],
fi
])
+AC_DEFUN([ENABLE_GHC_TOOLCHAIN_NOT_ARG],
+[
+ if test "$2" = "NO"; then
+ echo "--enable-$1" >> acargs
+ elif test "$2" = "YES"; then
+ echo "--disable-$1" >> acargs
+ fi
+])
+
AC_DEFUN([INVOKE_GHC_TOOLCHAIN],
[
(
@@ -78,14 +87,18 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN],
echo "--output=default.ghc-toolchain.target" >> acargs
echo "--llvm-triple=$LlvmTarget" >> acargs
echo "--cc=$CC" >> acargs
- echo "--readelf=$READELF" >> acargs
+ echo "--cxx=$CXX" >> acargs
echo "--cpp=$CPPCmd" >> acargs
echo "--hs-cpp=$HaskellCPPCmd" >> acargs
echo "--cc-link=$CC" >> acargs
- echo "--cxx=$CXX" >> acargs
echo "--ar=$AR" >> acargs
echo "--ranlib=$RANLIB" >> acargs
echo "--nm=$NM" >> acargs
+ echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs
+ echo "--readelf=$READELF" >> acargs
+ echo "--windres=$WindresCmd" >> acargs
+ echo "--dllwrap=$DllWrapCmd" >> acargs
+ ENABLE_GHC_TOOLCHAIN_NOT_ARG([locally-executable], [$CrossCompiling])
ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised])
ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode])
=====================================
m4/prep_target_file.m4
=====================================
@@ -7,14 +7,11 @@
#
# $1 = optional value
AC_DEFUN([PREP_MAYBE_SIMPLE_PROGRAM],[
- case "$$1" in
- /bin/false)
+ if test -z "$$1"; then
$1MaybeProg=Nothing
- ;;
- *)
+ else
$1MaybeProg="Just (Program {prgPath = \"$$1\", prgFlags = @<:@@:>@})"
- ;;
- esac
+ fi
AC_SUBST([$1MaybeProg])
])
@@ -55,6 +52,26 @@ AC_DEFUN([PREP_BOOLEAN],[
AC_SUBST([$1Bool])
])
+# PREP_NOT_BOOLEAN
+# ============
+#
+# Issue a substitution with True/False of [Not$1Bool] when $1 has NO/YES value
+# $1 = boolean variable to substitute
+AC_DEFUN([PREP_NOT_BOOLEAN],[
+ case "$$1" in
+ NO)
+ Not$1Bool=True
+ ;;
+ YES)
+ Not$1Bool=False
+ ;;
+ *)
+ AC_MSG_ERROR([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1])
+ ;;
+ esac
+ AC_SUBST([Not$1Bool])
+])
+
# PREP_LIST
# ============
#
@@ -106,16 +123,17 @@ AC_DEFUN([PREP_TARGET_FILE],[
PREP_BOOLEAN([UseLibffiForAdjustors])
PREP_BOOLEAN([ArIsGNUAr])
PREP_BOOLEAN([ArNeedsRanLib])
+ PREP_NOT_BOOLEAN([CrossCompiling])
PREP_LIST([SettingsMergeObjectsFlags])
PREP_LIST([ArArgs])
PREP_LIST([SettingsCCompilerLinkFlags])
PREP_LIST([SettingsHaskellCPPFlags])
- PREP_LIST([SettingsCPPFlags])
- PREP_LIST([SettingsCxxCompilerFlags])
- PREP_LIST([SettingsCCompilerFlags])
- PREP_MAYBE_SIMPLE_PROGRAM([SettingsDllWrapCommand])
- PREP_MAYBE_SIMPLE_PROGRAM([SettingsWindresCommand])
- PREP_MAYBE_STRING([HostVendor_CPP])
+ PREP_LIST([CPPFLAGS])
+ PREP_LIST([CXXFLAGS])
+ PREP_LIST([CFLAGS])
+ PREP_MAYBE_SIMPLE_PROGRAM([DllWrapCmd])
+ PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd])
+ PREP_MAYBE_STRING([TargetVendor_CPP])
dnl PREP_ENDIANNESS
case "$TargetWordBigEndian" in
=====================================
utils/ghc-toolchain/Main.hs
=====================================
@@ -33,6 +33,7 @@ import GHC.Toolchain.Tools.Readelf
data Opts = Opts
{ optTriple :: String
, optTargetPrefix :: Maybe String
+ , optLocallyExecutable :: Maybe Bool
, optLlvmTriple :: Maybe String
, optOutput :: String
, optCc :: ProgOpt
@@ -59,6 +60,7 @@ emptyOpts :: Opts
emptyOpts = Opts
{ optTriple = ""
, optTargetPrefix = Nothing
+ , optLocallyExecutable = Nothing
, optLlvmTriple = Nothing
, optOutput = ""
, optCc = po0
@@ -111,16 +113,11 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x})
_optTargetPrefix :: Lens Opts (Maybe String)
_optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x})
-_optUnregisterised :: Lens Opts (Maybe Bool)
+_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool)
+_optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x})
_optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x})
-
-_optTablesNextToCode :: Lens Opts (Maybe Bool)
_optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x})
-
-_optUseLibFFIForAdjustors :: Lens Opts (Maybe Bool)
_optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x})
-
-_optLdOvveride :: Lens Opts (Maybe Bool)
_optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x})
_optVerbosity :: Lens Opts Int
@@ -143,6 +140,7 @@ options =
, enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode
, enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optUseLibFFIForAdjustors
, enableDisable "ld-override" "override gcc's default linker" _optLdOvveride
+ , enableDisable "locally-executable" "A target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable
] ++
concat
[ progOpts "cc" "C compiler" _optCc
@@ -191,6 +189,7 @@ options =
targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX")
"A target prefix which will be added to all tool names when searching for toolchain components"
+
verbosityOpt = Option ['v'] ["verbose"] (OptArg f "N") "set output verbosity"
where
f mb = set _optVerbosity (parseVerbosity mb)
@@ -219,6 +218,7 @@ main = do
Just prefix -> Just prefix
Nothing -> Just $ optTriple opts ++ "-"
, keepTemp = optKeepTemp opts
+ , canLocallyExecute = fromMaybe True (optLocallyExecutable opts)
, logContexts = []
}
r <- runM env (run opts)
@@ -251,16 +251,18 @@ registerisedSupported archOs =
ArchARM _ _ _ -> True
ArchAArch64 -> True
ArchRISCV64 -> True
+ ArchWasm32 -> True
+ ArchJavaScript -> True
_ -> False
determineUnregisterised :: ArchOS -> Maybe Bool -> M Bool
determineUnregisterised archOs userReq =
case userReq of
- Just False
+ Just False -- user requested registerised build
| not regSupported -> throwE "GHC doesn't support registerised compilation on this architecture"
| otherwise -> return False
Just True -> return True
- Nothing
+ Nothing -- user wasn't explicit, do registerised if we support it
| regSupported -> return False
| otherwise -> return True
where
@@ -370,6 +372,7 @@ mkTarget opts = do
let t = Target { tgtArchOs = archOs
, tgtVendor
+ , tgtLocallyExecutable = fromMaybe True (optLocallyExecutable opts)
, tgtCCompiler = cc
, tgtCxxCompiler = cxx
, tgtCPreprocessor = cpp
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
=====================================
@@ -39,6 +39,7 @@ import System.IO hiding (readFile, writeFile, appendFile)
data Env = Env { verbosity :: Int
, targetPrefix :: Maybe String
, keepTemp :: Bool
+ , canLocallyExecute :: Bool
, logContexts :: [String]
}
@@ -53,7 +54,7 @@ getEnv :: M Env
getEnv = M $ lift Reader.ask
makeM :: IO (Either [Error] a) -> M a
-makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io)))
+makeM io = M (Except.ExceptT (Reader.ReaderT (\_env -> io)))
data Error = Error { errorMessage :: String
, errorLogContexts :: [String]
@@ -116,8 +117,13 @@ appendFile path s = liftIO $ Prelude.appendFile path s
createFile :: FilePath -> M ()
createFile path = writeFile path ""
+-- | Branch on whether we're cross-compiling, that is, if the Target we're
+-- producing differs from the platform we're producing it on.
ifCrossCompiling
:: M a -- ^ what to do when cross-compiling
-> M a -- ^ what to do otherwise
-> M a
-ifCrossCompiling cross other = other -- TODO
+ifCrossCompiling cross other = do
+ canExec <- canLocallyExecute <$> getEnv
+ if not canExec then cross -- can't execute, this is a cross target
+ else other -- can execute, run the other action
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
=====================================
@@ -42,7 +42,7 @@ data Target = Target
{ -- Platform
tgtArchOs :: ArchOS
, tgtVendor :: Maybe String
- -- , tgtHostCanExecute :: Bool -- TODO: Rename hostCanExecute? We might need this to determine whether or not we can execute a program when configuring it
+ , tgtLocallyExecutable :: Bool
, tgtSupportsGnuNonexecStack :: Bool
, tgtSupportsSubsectionsViaSymbols :: Bool
, tgtSupportsIdentDirective :: Bool
@@ -79,6 +79,7 @@ instance Show Target where
[ "Target"
, "{ tgtArchOs = " ++ show tgtArchOs
, ", tgtVendor = " ++ show tgtVendor
+ , ", tgtLocallyExecutable = " ++ show tgtLocallyExecutable
, ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack
, ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols
, ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
=====================================
@@ -141,37 +141,36 @@ compileAsm = compile "S" ["-c"] _ccProgram
addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc
addPlatformDepCcFlags archOs cc0 = do
let cc1 = addWorkaroundFor7799 archOs cc0
- cc2 <- addOSMinGW32CcFlags archOs cc1
-- As per FPTOOLS_SET_C_LD_FLAGS
case archOs of
ArchOS ArchX86 OSMinGW32 ->
- return $ cc2 & _ccFlags %++ "-march=i686"
+ return $ cc1 & _ccFlags %++ "-march=i686"
ArchOS ArchX86 OSFreeBSD ->
- return $ cc2 & _ccFlags %++ "-march=i686"
+ return $ cc1 & _ccFlags %++ "-march=i686"
ArchOS ArchX86_64 OSSolaris2 ->
-- Solaris is a multi-lib platform, providing both 32- and 64-bit
-- user-land. It appears to default to 32-bit builds but we of course want to
-- compile for 64-bits on x86-64.
- return $ cc2 & _ccFlags %++ "-m64"
+ return $ cc1 & _ccFlags %++ "-m64"
ArchOS ArchAlpha _ ->
-- For now, to suppress the gcc warning "call-clobbered
-- register used for global register variable", we simply
-- disable all warnings altogether using the -w flag. Oh well.
- return $ cc2 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"])
+ return $ cc1 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"])
-- ArchOS ArchHPPA? _ ->
ArchOS ArchARM{} OSFreeBSD ->
-- On arm/freebsd, tell gcc to generate Arm
-- instructions (ie not Thumb).
- return $ cc2 & _ccFlags %++ "-marm"
+ return $ cc1 & _ccFlags %++ "-marm"
ArchOS ArchARM{} OSLinux ->
-- On arm/linux and arm/android, tell gcc to generate Arm
-- instructions (ie not Thumb).
- return $ cc2 & _ccFlags %++ "-marm"
+ return $ cc1 & _ccFlags %++ "-marm"
ArchOS ArchPPC OSAIX ->
-- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`.
- return $ cc2 & _ccFlags %++ "-D_THREAD_SAFE"
+ return $ cc1 & _ccFlags %++ "-D_THREAD_SAFE"
_ ->
- return cc2
+ return cc1
-- | Workaround for #7799
@@ -180,18 +179,3 @@ addWorkaroundFor7799 archOs cc
| ArchX86 <- archOS_arch archOs = cc & _ccFlags %++ "-U__i686"
| otherwise = cc
--- | Adds flags specific to mingw32
-addOSMinGW32CcFlags :: ArchOS -> Cc -> M Cc
-addOSMinGW32CcFlags archOs cc
- | ArchOS _ OSMinGW32 <- archOs = do
- checkFStackCheck cc <|> throwE "Windows requires -fstack-check support yet the C compiler appears not to support it"
- | otherwise = return cc
-
--- | Check that @cc@ supports @-fstack-check at .
--- See Note [Windows stack allocations].
-checkFStackCheck :: Cc -> M Cc
-checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works" $ do
- let cc' = cc & _ccFlags %++ "-Wl,-fstack-checkzz"
- compileC cc' (dir </> "test.o") "int main(int argc, char **argv) { return 0; }"
- return cc'
-
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -166,8 +166,11 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do
compileC cc main_o "int f(int a); int main(int argc, char **argv) { return f(0); }"
let out = dir </> "test"
+ err = "linker didn't produce any output"
callProgram ccLink ["-o", out, test_o, main_o]
- expectFileExists out "linker didn't produce any output"
+ expectFileExists out err
+ -- Linking in windows might produce an executable with an ".exe" extension
+ <|> expectFileExists (out <.> "exe") err
checkLinkIsGnu :: Program -> M Bool
checkLinkIsGnu ccLink = do
@@ -244,6 +247,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program
addPlatformDepLinkFlags archOs cc ccLink0 = do
ccLink1 <- addNoAsNeeded archOs cc ccLink0
+ ccLink2 <- addOSMinGW32CcFlags archOs cc ccLink1
-- As per FPTOOLS_SET_C_LD_FLAGS
case archOs of
-- ROMES:TODO: Consider dropping this alongside other configuration for solaris that was dropped
@@ -254,32 +258,47 @@ addPlatformDepLinkFlags archOs cc ccLink0 = do
--
-- On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris
-- implementation, which rather uses the -64 flag.
- return $ ccLink1 & _prgFlags %++ "-m64"
+ return $ ccLink2 & _prgFlags %++ "-m64"
ArchOS ArchAlpha _ ->
-- For now, to suppress the gcc warning "call-clobbered
-- register used for global register variable", we simply
-- disable all warnings altogether using the -w flag. Oh well.
- return $ ccLink1 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"])
+ return $ ccLink2 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"])
-- ArchOS ArchHPPA? _ ->
ArchOS ArchARM{} OSFreeBSD ->
-- On arm/freebsd, tell gcc to generate Arm
-- instructions (ie not Thumb).
- return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack"
+ return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack"
ArchOS ArchARM{} OSLinux ->
-- On arm/linux and arm/android, tell gcc to generate Arm
-- instructions (ie not Thumb).
- return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack"
+ return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack"
ArchOS ArchAArch64 OSFreeBSD ->
- return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack"
+ return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack"
ArchOS ArchAArch64 OSLinux ->
- return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack"
+ return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack"
ArchOS ArchAArch64 OSNetBSD ->
- return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack"
+ return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack"
ArchOS ArchPPC OSAIX ->
-- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`.
- return $ ccLink1 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"])
+ return $ ccLink2 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"])
_ ->
- return ccLink1
+ return ccLink2
+
+-- | Adds flags specific to mingw32
+addOSMinGW32CcFlags :: ArchOS -> Cc -> Program -> M Program
+addOSMinGW32CcFlags archOs cc link
+ | ArchOS _ OSMinGW32 <- archOs = do
+ checkFStackCheck cc link <|> throwE "Windows requires -fstack-check support yet the C compiler linker appears not to support it"
+ | otherwise = return link
+
+-- | Check that @cc@ supports @-fstack-check at .
+-- See Note [Windows stack allocations].
+checkFStackCheck :: Cc -> Program -> M Program
+checkFStackCheck cc link = checking "that -fstack-check works" $ do
+ let link' = link & _prgFlags %++ "-fstack-check"
+ checkLinkWorks cc link'
+ return link'
-- | See Note [ELF needed shared libs]
addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87177664e31be26ec5dfb56790d792412d0a9168...465d92b1b0564d044d863b90eeeb0b5b99e1556a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87177664e31be26ec5dfb56790d792412d0a9168...465d92b1b0564d044d863b90eeeb0b5b99e1556a
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230705/6fce7d47/attachment-0001.html>
More information about the ghc-commits
mailing list