[Git][ghc/ghc][wip/toolchain-selection] ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon May 8 18:05:42 UTC 2023
Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC
Commits:
d1387b26 by Rodrigo Mesquita at 2023-05-08T19:05:32+01:00
ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList
A more complete ghc-toolchain.
Added configuration of:
* Use libffi for adjustors
* Supports compact unwind
* Supports filelist
- - - - -
7 changed files:
- configure.ac
- − m4/ghc_adjustors_method.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:
=====================================
configure.ac
=====================================
@@ -979,14 +979,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
=====================================
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
-])
=====================================
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
=====================================
@@ -42,15 +42,15 @@ data Target = Target
, tgtUnregisterised :: Bool
, tgtTablesNextToCode :: Bool
-- , tgtHasRtsLinker :: Bool -- NO NEED! Rebase on MR removing it.
- -- , tgtHasThreadedRts :: Bool
- , tgtUseLibffi :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for 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 -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient
, tgtCCompilerLink :: CcLink
- -- , tgtLd :: Program -- needed? probably not
+ -- , 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 -- Most ar implementations do good things by default without ranlib so don't need it
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -34,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
@@ -79,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"
@@ -91,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/-/commit/d1387b26399d0fa2dce2e6948afbab3ba80dfb0a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1387b26399d0fa2dce2e6948afbab3ba80dfb0a
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/20230508/e01b9f84/attachment-0001.html>
More information about the ghc-commits
mailing list