[Git][ghc/ghc][wip/toolchain-selection] 4 commits: ROMES WIP
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Fri May 12 14:03:24 UTC 2023
Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC
Commits:
c0994e19 by Rodrigo Mesquita at 2023-05-12T15:03:08+01:00
ROMES WIP
- - - - -
5effd627 by Rodrigo Mesquita at 2023-05-12T15:03:13+01:00
ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList
A more complete ghc-toolchain.
Added configuration of:
* Use libffi for adjustors
* Supports compact unwind
* Supports filelist
- - - - -
10c05b78 by Rodrigo Mesquita at 2023-05-12T15:03:13+01:00
Handle passing CPP cmd and flags from configure to ghc-toolchain
- - - - -
96257cb0 by Rodrigo Mesquita at 2023-05-12T15:03:13+01:00
Rip more of configure that is no longer being used
- - - - -
13 changed files:
- compiler/GHC/Linker/Static.hs
- configure.ac
- hadrian/src/Builder.hs
- hadrian/src/Rules/Libffi.hs
- − m4/fp_cpp_cmd_with_args.m4
- m4/fptools_set_haskell_platform_vars.m4
- − m4/ghc_adjustors_method.m4
- m4/ghc_toolchain.m4
- utils/ghc-toolchain/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
Changes:
=====================================
compiler/GHC/Linker/Static.hs
=====================================
@@ -69,6 +69,7 @@ linkBinary = linkBinary' False
linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
+ -- ROMES:TODO: A big part of this ought to be configured by ghc-toolchain
let platform = ue_platform unit_env
unit_state = ue_units unit_env
toolSettings' = toolSettings dflags
@@ -239,6 +240,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
then ["-Wl,-read_only_relocs,suppress"]
else [])
+ -- We should rather be asking does it support --gc-sections?
++ (if toolSettings_ldIsGnuLd toolSettings' &&
not (gopt Opt_WholeArchiveHsLibs dflags)
then ["-Wl,--gc-sections"]
=====================================
configure.ac
=====================================
@@ -448,11 +448,37 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0])
dnl make extensions visible to allow feature-tests to detect them lateron
AC_USE_SYSTEM_EXTENSIONS
-dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`)
-AC_PROG_CPP
-
# --with-hs-cpp/--with-hs-cpp-flags
-FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs)
+AC_ARG_WITH(hs-cpp,
+[AS_HELP_STRING([--with-hs-cpp=ARG],
+ [Path to the (C) preprocessor for Haskell files [default=autodetect]])],
+[
+ if test "$HostOS" = "mingw32"
+ then
+ AC_MSG_WARN([Request to use $withval will be ignored])
+ else
+ HaskellCPPCmd=$withval
+ fi
+],
+[
+ # We can't use $CPP here, since HaskellCPPCmd is expected to be a single
+ # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E".
+ HaskellCPPCmd=$CC
+]
+)
+AC_ARG_WITH(hs-cpp-flags,
+ [AS_HELP_STRING([--with-hs-cpp-flags=ARG],
+ [Flags to the (C) preprocessor for Haskell files [default=autodetect]])],
+ [
+ if test "$HostOS" = "mingw32"
+ then
+ AC_MSG_WARN([Request to use $withval will be ignored])
+ else
+ HaskellCPPArgs=$withval
+ fi
+ ],
+[ HaskellCPPArgs="" ]
+)
AC_SUBST([HaskellCPPCmd])
AC_SUBST([HaskellCPPArgs])
@@ -979,14 +1005,14 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap],
[Use mmap in the runtime linker])
-# TODO: Unregisterised, TablesNextToCode
-TablesNextToCode=YES
-AC_SUBST([TablesNextToCode])
-Unregisterised=YES
-AC_SUBST([Unregisterised])
-
+AC_ARG_ENABLE(libffi-adjustors,
+ [AS_HELP_STRING(
+ [--enable-libffi-adjustors],
+ [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])],
+ UseLibffiForAdjustors=$enableval,
+ dnl do nothing
+)
-GHC_ADJUSTORS_METHOD([Target])
AC_SUBST([UseLibffiForAdjustors])
dnl ** Other RTS features
=====================================
hadrian/src/Builder.hs
=====================================
@@ -43,6 +43,10 @@ import qualified Data.ByteString as BS
import qualified GHC.Foreign as GHC
import GHC.ResponseFile
+import GHC.Toolchain (Target(..))
+import qualified GHC.Toolchain as Toolchain
+import GHC.Toolchain.Program
+
-- | C compiler can be used in two different modes:
-- * Compile or preprocess a source file.
-- * Extract source dependencies by passing @-MM@ command line argument.
@@ -402,31 +406,35 @@ runHaddock haddockPath flagArgs fileInputs = withTempFile $ \tmp -> do
-- 'Objdump' is only required on OpenBSD and AIX. Add support for platform
-- specific optional builders as soon as we can reliably test this feature.
-- See https://github.com/snowleopard/hadrian/issues/211.
-isOptional :: Builder -> Bool
-isOptional = \case
+isOptional :: Toolchain.Target -- ^ Some builders are optional depending on the target
+ -> Builder
+ -> Bool
+isOptional target = \case
Objdump -> True
-- alex and happy are not required when building source distributions
-- and ./configure will complain if they are not available when building in-tree
Happy -> True
Alex -> True
+ -- Most ar implemententions no longer need ranlib, but some still do
+ Ranlib -> not $ Toolchain.arNeedsRanlib (tgtAr target)
_ -> False
-- | Determine the location of a system 'Builder'.
systemBuilderPath :: Builder -> Action FilePath
systemBuilderPath builder = case builder of
Alex -> fromKey "alex"
- Ar _ (Stage0 {})-> fromKey "system-ar"
- Ar _ _ -> fromKey "ar"
+ Ar _ (Stage0 {})-> fromHostTC "system-ar" (Toolchain.arMkArchive . tgtAr)
+ Ar _ _ -> fromTargetTC "ar" (Toolchain.arMkArchive . tgtAr)
Autoreconf _ -> stripExe =<< fromKey "autoreconf"
- Cc _ (Stage0 {}) -> fromKey "system-cc"
- Cc _ _ -> fromKey "cc"
+ Cc _ (Stage0 {}) -> fromHostTC "system-cc" (Toolchain.ccProgram . tgtCCompiler)
+ Cc _ _ -> fromTargetTC "cc" (Toolchain.ccProgram . tgtCCompiler)
-- We can't ask configure for the path to configure!
Configure _ -> return "configure"
Ghc _ (Stage0 {}) -> fromKey "system-ghc"
GhcPkg _ (Stage0 {}) -> fromKey "system-ghc-pkg"
Happy -> fromKey "happy"
HsCpp -> fromKey "hs-cpp"
- Ld _ -> fromKey "ld"
+ Ld _ -> fromTargetTC "ld" (Toolchain.ccLinkProgram . tgtCCompilerLink)
-- MergeObjects Stage0 is a special case in case of
-- cross-compiling. We're building stage1, e.g. code which will be
-- executed on the host and hence we need to use host's merge
@@ -435,15 +443,15 @@ 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 {}) -> fromKey "system-merge-objects"
- MergeObjects _ -> fromKey "merge-objects"
+ MergeObjects (Stage0 {}) -> fromHostTC "system-merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs)
+ MergeObjects _ -> fromTargetTC "merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs)
Make _ -> fromKey "make"
Makeinfo -> fromKey "makeinfo"
- Nm -> fromKey "nm"
+ Nm -> fromTargetTC "nm" (Toolchain.nmProgram . tgtNm)
Objdump -> fromKey "objdump"
Patch -> fromKey "patch"
Python -> fromKey "python"
- Ranlib -> fromKey "ranlib"
+ Ranlib -> fromTargetTC "ranlib" (maybeProg Toolchain.ranlibProgram . tgtRanlib)
Testsuite _ -> fromKey "python"
Sphinx _ -> fromKey "sphinx-build"
Tar _ -> fromKey "tar"
@@ -459,10 +467,24 @@ systemBuilderPath builder = case builder of
let unpack = fromMaybe . error $ "Cannot find path to builder "
++ quote key ++ inCfg ++ " Did you skip configure?"
path <- unpack <$> lookupValue configFile key
+ validate key path
+
+ -- Get program from the host's target configuration
+ fromHostTC keyname key = do
+ path <- queryHostTargetConfig (prgPath . key)
+ validate keyname path
+
+ -- Get program from the target's target configuration
+ fromTargetTC keyname key = do
+ path <- queryTargetTargetConfig (prgPath . key)
+ validate keyname path
+
+ validate keyname path = do
+ target <- getTargetTargetConfig
if null path
then do
- unless (isOptional builder) . error $ "Non optional builder "
- ++ quote key ++ " is not specified" ++ inCfg
+ unless (isOptional target builder) . error $ "Non optional builder "
+ ++ quote keyname ++ " is not specified" ++ inCfg
return "" -- TODO: Use a safe interface.
else do
-- angerman: I find this lookupInPath rather questionable.
@@ -488,6 +510,8 @@ systemBuilderPath builder = case builder of
exists <- doesFileExist s
if exists then return s else return sNoExt
+ maybeProg = maybe (Program "" [])
+
-- | Was the path to a given system 'Builder' specified in configuration files?
isSpecified :: Builder -> Action Bool
=====================================
hadrian/src/Rules/Libffi.hs
=====================================
@@ -135,7 +135,11 @@ configureEnvironment stage = do
ldFlags <- interpretInContext context ldArgs
sequence [ builderEnvironment "CC" $ Cc CompileC stage
, builderEnvironment "CXX" $ Cc CompileC stage
- , builderEnvironment "LD" (Ld stage)
+ -- , builderEnvironment "LD" (Ld stage) -- Libffi is a C library,
+ -- it will use c compiler to link, not LD
+ -- ROMES: Ben's money on this not being used
+ -- If configure or deps ask for LD ...
+ -- try to, at least.
, builderEnvironment "AR" (Ar Unpack stage)
, builderEnvironment "NM" Nm
, builderEnvironment "RANLIB" Ranlib
=====================================
m4/fp_cpp_cmd_with_args.m4 deleted
=====================================
@@ -1,69 +0,0 @@
-# FP_CPP_CMD_WITH_ARGS()
-# ----------------------
-# sets CPP command and its arguments
-#
-# $1 = the variable to set to CPP command
-# $2 = the variable to set to CPP command arguments
-
-AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[
-dnl ** what cpp to use?
-dnl --------------------------------------------------------------
-AC_ARG_WITH(hs-cpp,
-[AS_HELP_STRING([--with-hs-cpp=ARG],
- [Path to the (C) preprocessor for Haskell files [default=autodetect]])],
-[
- if test "$HostOS" = "mingw32"
- then
- AC_MSG_WARN([Request to use $withval will be ignored])
- else
- HS_CPP_CMD=$withval
- fi
-],
-[
-
- # We can't use $CPP here, since HS_CPP_CMD is expected to be a single
- # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E".
- HS_CPP_CMD=$CC
-
-]
-)
-
-dnl ** what cpp flags to use?
-dnl -----------------------------------------------------------
-AC_ARG_WITH(hs-cpp-flags,
- [AS_HELP_STRING([--with-hs-cpp-flags=ARG],
- [Flags to the (C) preprocessor for Haskell files [default=autodetect]])],
- [
- if test "$HostOS" = "mingw32"
- then
- AC_MSG_WARN([Request to use $withval will be ignored])
- else
- HS_CPP_ARGS=$withval
- fi
- ],
-[
- $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1
- if grep "__clang__" conftest.txt >/dev/null 2>&1; then
- HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs"
- else
- $HS_CPP_CMD -v > conftest.txt 2>&1
- if grep "gcc" conftest.txt >/dev/null 2>&1; then
- HS_CPP_ARGS="-E -undef -traditional"
- else
- $HS_CPP_CMD --version > conftest.txt 2>&1
- if grep "cpphs" conftest.txt >/dev/null 2>&1; then
- HS_CPP_ARGS="--cpp -traditional"
- else
- AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly])
- HS_CPP_ARGS=""
- fi
- fi
- fi
- ]
-)
-
-$1=$HS_CPP_CMD
-$2=$HS_CPP_ARGS
-
-])
-
=====================================
m4/fptools_set_haskell_platform_vars.m4
=====================================
@@ -1,133 +1,3 @@
-# FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS
-# ----------------------------------
-# Drop in shell functions used by FPTOOLS_SET_HASKELL_PLATFORM_VARS
-AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS],
-[
- checkArch() {
- case [$]1 in
- i386)
- test -z "[$]2" || eval "[$]2=ArchX86"
- ;;
- x86_64|amd64)
- test -z "[$]2" || eval "[$]2=ArchX86_64"
- ;;
- powerpc)
- test -z "[$]2" || eval "[$]2=ArchPPC"
- ;;
- powerpc64)
- test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V1\""
- ;;
- powerpc64le)
- test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V2\""
- ;;
- s390x)
- test -z "[$]2" || eval "[$]2=ArchS390X"
- ;;
- arm)
- GET_ARM_ISA()
- test -z "[$]2" || eval "[$]2=\"ArchARM \$ARM_ISA \$ARM_ISA_EXT \$ARM_ABI\""
- ;;
- aarch64)
- test -z "[$]2" || eval "[$]2=ArchAArch64"
- ;;
- alpha)
- test -z "[$]2" || eval "[$]2=ArchAlpha"
- ;;
- mips|mipseb)
- test -z "[$]2" || eval "[$]2=ArchMipseb"
- ;;
- mipsel)
- test -z "[$]2" || eval "[$]2=ArchMipsel"
- ;;
- riscv64)
- test -z "[$]2" || eval "[$]2=ArchRISCV64"
- ;;
- wasm32)
- test -z "[$]2" || eval "[$]2=ArchWasm32"
- ;;
- loongarch64)
- test -z "[$]2" || eval "[$]2=ArchLoongArch64"
- ;;
- hppa|hppa1_1|ia64|m68k|nios2|riscv32|loongarch32|rs6000|s390|sh4|vax)
- test -z "[$]2" || eval "[$]2=ArchUnknown"
- ;;
- javascript)
- test -z "[$]2" || eval "[$]2=ArchJavaScript"
- ;;
- *)
- echo "Unknown arch [$]1"
- exit 1
- ;;
- esac
- }
-
- checkVendor() {
- case [$]1 in
- dec|none|unknown|hp|apple|next|sun|sgi|ibm|montavista|portbld|alpine)
- ;;
- *)
- AC_MSG_WARN([Unknown vendor [$]1])
- ;;
- esac
- }
-
- checkOS() {
- case [$]1 in
- linux|linux-android)
- test -z "[$]2" || eval "[$]2=OSLinux"
- ;;
- darwin|ios|watchos|tvos)
- test -z "[$]2" || eval "[$]2=OSDarwin"
- ;;
- solaris2)
- test -z "[$]2" || eval "[$]2=OSSolaris2"
- ;;
- mingw32|windows)
- test -z "[$]2" || eval "[$]2=OSMinGW32"
- ;;
- freebsd)
- test -z "[$]2" || eval "[$]2=OSFreeBSD"
- ;;
- dragonfly)
- test -z "[$]2" || eval "[$]2=OSDragonFly"
- ;;
- kfreebsdgnu)
- test -z "[$]2" || eval "[$]2=OSKFreeBSD"
- ;;
- openbsd)
- test -z "[$]2" || eval "[$]2=OSOpenBSD"
- ;;
- netbsd)
- test -z "[$]2" || eval "[$]2=OSNetBSD"
- ;;
- haiku)
- test -z "[$]2" || eval "[$]2=OSHaiku"
- ;;
- nto-qnx)
- test -z "[$]2" || eval "[$]2=OSQNXNTO"
- ;;
- wasi)
- test -z "[$]2" || eval "[$]2=OSWasi"
- ;;
- dragonfly|hpux|linuxaout|freebsd2|nextstep2|nextstep3|sunos4|ultrix)
- test -z "[$]2" || eval "[$]2=OSUnknown"
- ;;
- aix)
- test -z "[$]2" || eval "[$]2=OSAIX"
- ;;
- gnu)
- test -z "[$]2" || eval "[$]2=OSHurd"
- ;;
- ghcjs|js)
- test -z "[$]2" || eval "[$]2=OSUnknown"
- ;;
- *)
- echo "Unknown OS '[$]1'"
- exit 1
- ;;
- esac
- }
-])
# Note [autoconf assembler checks and -flto]
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -223,13 +93,3 @@ AC_DEFUN([GHC_GNU_NONEXEC_STACK],
CFLAGS="$CFLAGS2"
])
-# FPTOOLS_SET_HASKELL_PLATFORM_VARS
-# ----------------------------------
-# Set the Haskell platform variables
-AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
-[
- AC_REQUIRE([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS])
- checkArch "[$]$1Arch" "Haskell$1Arch"
- checkVendor "[$]$1Vendor"
- checkOS "[$]$1OS" "Haskell$1Os"
-])
=====================================
m4/ghc_adjustors_method.m4 deleted
=====================================
@@ -1,49 +0,0 @@
-dnl GHC_ADJUSTORS_METHOD(Platform)
-dnl --------------------------------------------------------------
-dnl Use libffi for adjustors?
-AC_DEFUN([GHC_ADJUSTORS_METHOD],
-[
- case [$]{$1[Arch]} in
- i386|x86_64)
- # We have native adjustor support on these platforms
- HaveNativeAdjustor=yes
- ;;
- *)
- HaveNativeAdjustor=no
- ;;
- esac
-
- AC_ARG_ENABLE(libffi-adjustors,
- [AS_HELP_STRING(
- [--enable-libffi-adjustors],
- [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])],
- UseLibffiForAdjustors=$enableval,
- dnl do nothing
- )
-
- AC_MSG_CHECKING([whether to use libffi for adjustors])
- if test "$UseLibffiForAdjustors" = "yes" ; then
- # Use libffi is the user explicitly requested it
- AdjustorType="libffi"
- elif test "$HaveNativeAdjustor" = "yes"; then
- # Otherwise if we have a native adjustor implementation use that
- AdjustorType="native"
- else
- # If we don't have a native adjustor implementation then default to libffi
- AdjustorType="libffi"
- fi
-
- case "$AdjustorType" in
- libffi)
- UseLibffiForAdjustors=YES
- AC_MSG_RESULT([yes])
- ;;
- native)
- UseLibffiForAdjustors=NO
- AC_MSG_RESULT([no])
- ;;
- *)
- AC_MSG_ERROR([Internal error: Invalid AdjustorType])
- exit 1
- esac
-])
=====================================
m4/ghc_toolchain.m4
=====================================
@@ -20,11 +20,13 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN],
echo "--triple=$target" >> acargs
echo "--cc=$CC" >> acargs
ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1])
- # TODO (previously we had in configure script use of --traditional??)
- # First thing disable the comment:
- # Also, differentiatiate between hscpp and cpp?
- #echo "--cpp=$CPP" >> acargs
+
+ # We can't use $CPP, since HS_CPP_CMD is expected to be a single
+ # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E".
+ echo "--cpp=$HaskellCPPCmd" >> acargs
+ # ROMES:TODO: CONF_CPP_OPTS_STAGE1 vs HaskellCPPArgs
ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1])
+
echo "--cc-link=$CC" >> acargs
ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1])
echo "--cxx=$CXX" >> acargs
=====================================
utils/ghc-toolchain/Main.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
module Main where
@@ -44,6 +45,7 @@ data Opts = Opts
, optDllwrap :: ProgOpt
, optUnregisterised :: Maybe Bool
, optTablesNextToCode :: Maybe Bool
+ , optUseLibFFIForAdjustors :: Maybe Bool
, optLdOverride :: Maybe Bool
, optVerbosity :: Int
, optKeepTemp :: Bool
@@ -66,6 +68,7 @@ emptyOpts = Opts
, optWindres = po0
, optUnregisterised = Nothing
, optTablesNextToCode = Nothing
+ , optUseLibFFIForAdjustors = Nothing
, optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here?
, optVerbosity = 0
, optKeepTemp = False
@@ -100,6 +103,9 @@ _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})
@@ -119,6 +125,7 @@ options =
concat
[ enableDisable "unregisterised" "unregisterised backend" _optUnregisterised
, 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
] ++
concat
@@ -250,6 +257,26 @@ determineTablesNextToCode archOs unreg userReq =
where
tntcSupported = tablesNextToCodeSupported archOs
+determineUseLibFFIForAdjustors :: ArchOS
+ -> Maybe Bool -- ^ Enable/disable option --libffi-adjustors
+ -> M Bool
+determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for adjustors" $
+ case mb of
+ Just True ->
+ -- The user explicitly requested it
+ pure True
+
+ _ ->
+ -- If don't have a native adjustor implementation we use libffi
+ pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we
+
+archHasNativeAdjustors :: Arch -> Bool
+archHasNativeAdjustors = \case
+ ArchX86 -> True
+ ArchX86_64 -> True
+ _ -> False
+
+
mkTarget :: Opts -> M Target
mkTarget opts = do
cc0 <- findCc (optCc opts)
@@ -290,6 +317,7 @@ mkTarget opts = do
tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts)
tgtTablesNextToCode <-
determineTablesNextToCode archOs tgtUnregisterised (optTablesNextToCode opts)
+ tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts)
when tgtUnregisterised $ do
-- The via-C code generator requires these
let prog = "int main(int argc, char** argv) { return 0; }I"
@@ -314,6 +342,7 @@ mkTarget opts = do
, tgtEndianness
, tgtUnregisterised
, tgtTablesNextToCode
+ , tgtUseLibffiForAdjustors = tgtUseLibffi
, tgtSymbolsHaveLeadingUnderscore
, tgtSupportsSubsectionsViaSymbols
, tgtSupportsIdentDirective
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
=====================================
@@ -12,6 +12,7 @@ module GHC.Toolchain.Monad
-- * File I/O
, readFile
, writeFile
+ , appendFile
, createFile
-- * Logging
@@ -21,7 +22,7 @@ module GHC.Toolchain.Monad
, withLogContext
) where
-import Prelude hiding (readFile, writeFile)
+import Prelude hiding (readFile, writeFile, appendFile)
import qualified Prelude
import Control.Applicative
@@ -31,7 +32,9 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import qualified Control.Monad.Trans.Reader as Reader
import qualified Control.Monad.Trans.Except as Except
-import System.IO hiding (readFile, writeFile)
+import System.IO hiding (readFile, writeFile, appendFile)
+-- import qualified System.Directory
+
data Env = Env { verbosity :: Int
, targetPrefix :: Maybe String
@@ -98,6 +101,14 @@ readFile path = liftIO $ Prelude.readFile path
writeFile :: FilePath -> String -> M ()
writeFile path s = liftIO $ Prelude.writeFile path s
+appendFile :: FilePath -> String -> M ()
+appendFile path s = liftIO $ Prelude.appendFile path s
+
+-- copyFile :: FilePath -- ^ Source file
+-- -> FilePath -- ^ Destination file
+-- -> M ()
+-- copyFile src dst = liftIO $ System.Directory.copyFile src dst
+
-- | Create an empty file.
createFile :: FilePath -> M ()
createFile path = writeFile path ""
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs
=====================================
@@ -8,4 +8,4 @@ module GHC.Toolchain.Prelude
import GHC.Toolchain.Monad
import GHC.Toolchain.Lens
import Control.Applicative
-import Prelude hiding (writeFile, readFile)
+import Prelude hiding (writeFile, readFile, appendFile)
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
=====================================
@@ -29,7 +29,7 @@ data Endianness = LittleEndian | BigEndian
data Target = Target
{ -- Platform
tgtArchOs :: ArchOS
- -- , tgtCrossCompiling :: Bool -- TODO: Rename hostCanExecute?
+ -- , tgtCrossCompiling :: Bool -- TODO: Rename hostCanExecute? We probably don't need this.
, tgtSupportsGnuNonexecStack :: Bool
, tgtSupportsSubsectionsViaSymbols :: Bool
, tgtSupportsIdentDirective :: Bool
@@ -41,21 +41,19 @@ data Target = Target
-- GHC capabilities
, tgtUnregisterised :: Bool
, tgtTablesNextToCode :: Bool
- -- , tgtHasRtsLinker :: Bool -- Hmm?
- -- , tgtHasThreadedRts :: Bool
- -- , tgtUseLibffi :: Bool
+ -- , tgtHasRtsLinker :: Bool -- NO NEED! Rebase on MR removing it.
+ -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping?
+ , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it
-- C toolchain
, tgtCCompiler :: Cc
, tgtCxxCompiler :: Cxx
- , tgtCPreprocessor :: Cpp
+ , tgtCPreprocessor :: Cpp -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient
, tgtCCompilerLink :: CcLink
- -- , tgtLd :: Program -- needed?
- -- , tgtLdSupportsCompactUnwind :: Bool
- -- , tgtLdSupportsFilelist :: Bool
- -- , tgtLdIsGnuLd :: Bool -- needed?
+ -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler
+ -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed)
, tgtAr :: Ar
- , tgtRanlib :: Maybe Ranlib
+ , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it
, tgtNm :: Nm
, tgtMergeObjs :: Maybe MergeObjs
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -18,7 +18,9 @@ import GHC.Toolchain.Tools.Readelf
-- | Configuration on how the C compiler can be used to link
data CcLink = CcLink { ccLinkProgram :: Program
- , ccLinkSupportsNoPie :: Bool
+ , ccLinkSupportsNoPie :: Bool -- Does have to be a separate settings. Sometimes we do want to use PIE
+ , ccLinkSupportsCompactUnwind :: Bool -- Argument to be made about this being part of the cclink flags
+ , ccLinkSupportsFilelist :: Bool -- This too
}
deriving (Show, Read, Eq, Ord)
@@ -32,10 +34,12 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l
-- If not then try to find a decent linker on our own
rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc]
findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink
- ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram
+ ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram
+ ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram
+ ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram
checkBfdCopyBug archOs cc readelf ccLinkProgram
ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram
- return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie}
+ return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist}
-- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@
findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program
@@ -77,8 +81,9 @@ doLinkerSearch = False
#endif
checkSupportsNoPie :: Program -> M Bool
-checkSupportsNoPie ccLink = withTempDir $ \dir -> do
- let test_c = dir </> "test.o"
+checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $
+ withTempDir $ \dir -> do
+ let test_c = dir </> "test.c"
writeFile test_c "int main() { return 0; }"
let test = dir </> "test"
@@ -89,6 +94,41 @@ checkSupportsNoPie ccLink = withTempDir $ \dir -> do
then return False
else return True
+checkSupportsCompactUnwind :: Cc -> Program -> M Bool
+checkSupportsCompactUnwind cc ccLink = checking "whether ld understands -no_compact_unwind" $
+ withTempDir $ \dir -> do
+ let test_c = dir </> "test.c"
+ test_o = dir </> "test.o"
+ test2_o = dir </> "test2.o"
+ writeFile test_c "int foo() { return 0; }"
+ callProgram (ccProgram cc) ["-c", test_c]
+ exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o]
+ pure $ isSuccess exitCode
+
+
+checkSupportsFilelist :: Cc -> Program -> M Bool
+checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $
+ withTempDir $ \dir -> do
+ let test_o = dir </> "test.o"
+ test1_c = dir </> "test1.c"
+ test2_c = dir </> "test2.c"
+ test1_o = dir </> "test1.o"
+ test2_o = dir </> "test2.o"
+ test_ofiles = dir </> "test.o-files"
+
+ writeFile test1_c "int foo() { return 0; }"
+ writeFile test2_c "int bar() { return 0; }"
+
+ callProgram (ccProgram cc) ["-c", test1_c]
+ callProgram (ccProgram cc) ["-c", test2_c]
+
+ writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file
+ appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file
+
+ exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o]
+
+ pure $ isSuccess exitCode
+
-- | Check whether linking works.
checkLinkWorks :: Cc -> Program -> M ()
checkLinkWorks cc ccLink = withTempDir $ \dir -> do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef11d6086beb968266186bf172f690d53e974860...96257cb0cc5d51fe31859d15d9318bac913a86bd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef11d6086beb968266186bf172f690d53e974860...96257cb0cc5d51fe31859d15d9318bac913a86bd
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/20230512/180c094b/attachment-0001.html>
More information about the ghc-commits
mailing list