[Git][ghc/ghc][wip/toolchain-selection] FixeWs
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Wed Jul 5 11:33:42 UTC 2023
Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC
Commits:
87177664 by Rodrigo Mesquita at 2023-07-05T12:33:30+01:00
FixeWs
- - - - -
9 changed files:
- TODO
- default.target.in
- hadrian/src/Oracles/Setting.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/Tools/Cc.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
Changes:
=====================================
TODO
=====================================
@@ -1,2 +1,5 @@
+Things that might get done on this or another MR
+[ ] 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,6 @@
Target
-{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@}
-, tgtVendor = @HostVendor_CPPMaybeStr@
+{ tgtArchOs = ArchOS {archOS_arch = @HaskellTargetArch@, archOS_OS = @HaskellTargetOs@}
+, tgtVendor = @TargetVendor_CPPMaybeStr@
, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@
, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@
, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@
@@ -34,6 +34,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/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
=====================================
m4/ghc_toolchain.m4
=====================================
@@ -78,14 +78,17 @@ 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_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])
])
@@ -113,9 +110,9 @@ AC_DEFUN([PREP_TARGET_FILE],[
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_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
=====================================
@@ -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
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
=====================================
@@ -53,7 +53,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,6 +116,8 @@ 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
=====================================
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/-/commit/87177664e31be26ec5dfb56790d792412d0a9168
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87177664e31be26ec5dfb56790d792412d0a9168
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/f846613a/attachment-0001.html>
More information about the ghc-commits
mailing list