[Git][ghc/ghc][wip/toolchain-selection] 3 commits: configure: Create and validate toolchain target file

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Tue Jun 6 15:29:06 UTC 2023



Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC


Commits:
a3642797 by Rodrigo Mesquita at 2023-06-06T16:25:44+01:00
configure: Create and validate toolchain target file

- - - - -
0a83e43d by Rodrigo Mesquita at 2023-06-06T16:27:04+01:00
Fixes for ghc-toolchain to match configure output

- - - - -
e398306c by Rodrigo Mesquita at 2023-06-06T16:27:46+01:00
Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now

- - - - -


17 changed files:

- configure.ac
- + default.target.in
- distrib/configure.ac.in
- m4/find_merge_objects.m4
- m4/fp_prog_ar_needs_ranlib.m4
- m4/ghc_toolchain.m4
- + m4/prep_target_file.m4
- utils/ghc-toolchain/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
- utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs


Changes:

=====================================
configure.ac
=====================================
@@ -644,7 +644,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly.
 FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0])
 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1])
 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2])
-FIND_GHC_TOOLCHAIN
 
 dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang
 dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too?
@@ -1174,6 +1173,10 @@ checkMake380() {
 checkMake380 make
 checkMake380 gmake
 
+# Toolchain target files
+PREP_TARGET_FILE
+FIND_GHC_TOOLCHAIN
+
 AC_CONFIG_FILES(
 [ mk/project.mk
   hadrian/cfg/system.config
@@ -1182,6 +1185,7 @@ AC_CONFIG_FILES(
   hadrian/ghci-stack
   docs/users_guide/ghc_config.py
   distrib/configure.ac
+  default.target
 ])
 
 dnl Create the VERSION file, satisfying #22322.
@@ -1282,3 +1286,6 @@ mk/build.mk.sample to mk/build.mk, and edit the settings in there.
 For more information on how to configure your GHC build, see
    https://gitlab.haskell.org/ghc/ghc/wikis/building
 "]
+
+VALIDATE_GHC_TOOLCHAIN
+


=====================================
default.target.in
=====================================
@@ -0,0 +1,39 @@
+Target
+{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@}
+, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@
+, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@
+, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@
+, tgtWordSize = WS at TargetWordSize@
+, tgtEndianness = @TargetEndianness@
+, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@
+, tgtLlvmTarget = "@LlvmTarget@"
+, 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 = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}}
+, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}}
+, tgtCCompilerLink = CcLink
+{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@}
+, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@
+, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@
+, ccLinkSupportsFilelist = @LdHasFilelistBool@
+, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@
+, ccLinkIsGnu = @LdIsGNULdBool@
+}
+
+, tgtAr = Ar
+{ arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@}
+, arIsGnu = @ArIsGNUArBool@
+, arSupportsAtFile = @ArSupportsAtFileBool@
+, arSupportsDashL = @ArSupportsDashLBool@
+, arNeedsRanlib = @ArNeedsRanLibBool@
+}
+
+, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@REAL_RANLIB_CMD@", prgFlags = []}})
+, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}}
+, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}})
+, tgtDllwrap = Nothing
+, tgtWindres = Nothing
+}


=====================================
distrib/configure.ac.in
=====================================
@@ -307,6 +307,11 @@ checkMake380() {
 checkMake380 make
 checkMake380 gmake
 
+# Toolchain target files
+PREP_TARGET_FILE
+FIND_GHC_TOOLCHAIN
+VALIDATE_GHC_TOOLCHAIN
+
 echo "****************************************************"
 echo "Configuration done, ready to 'make install'"
 echo "(see README and INSTALL files for more info.)"


=====================================
m4/find_merge_objects.m4
=====================================
@@ -7,7 +7,7 @@ AC_DEFUN([FIND_MERGE_OBJECTS],[
     AC_REQUIRE([FIND_LD])
 
     if test -z "$MergeObjsCmd"; then
-        MergeObjsCmd="$LD"
+        MergeObjsCmd="$(which $LD)"
     fi
     if test -z "$MergeObjsArgs"; then
         MergeObjsArgs="-r"


=====================================
m4/fp_prog_ar_needs_ranlib.m4
=====================================
@@ -46,4 +46,5 @@ AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[
     fi
     AC_SUBST([REAL_RANLIB_CMD])
     AC_SUBST([RANLIB_CMD])
+    AC_SUBST([ArNeedsRanLib],[`echo $fp_cv_prog_ar_needs_ranlib | tr 'a-z' 'A-Z'`])
 ])# FP_PROG_AR_NEEDS_RANLIB


=====================================
m4/ghc_toolchain.m4
=====================================
@@ -28,30 +28,33 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN],
         utils/ghc-toolchain/Main.hs -o acghc-toolchain
 
     rm -f acargs
-    echo "--triple=$target" >> acargs
-    echo "--cc=$CC" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1])
+    dnl TODO: LLVMTarget vs Target, which should go where?
+    dnl echo "--triple=$target" >> acargs
+    dnl For now, LlvmTarget matches the configure output.
+    echo "--triple=$LlvmTarget" >> acargs
+    # echo "--cc=$CC" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1])
 
-    # CPP flags
-    echo "--cpp=$CPPCmd" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1])
+    # # CPP flags
+    # echo "--cpp=$CPPCmd" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1])
 
-    # HS CPP flags
-    echo "--hs-cpp=$HaskellCPPCmd" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs])
+    # # HS CPP flags
+    # echo "--hs-cpp=$HaskellCPPCmd" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs])
 
-    echo "--cc-link=$CC" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1])
-    echo "--cxx=$CXX" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$CONF_CXX_OPTS_STAGE1])
-    echo "--ar=$AR" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([ar-opt], [$ARFLAGS])
-    echo "--ranlib=$RANLIB" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([ranlib-opt], [$RANLIBFLAGS])
-    echo "--nm=$NM" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([nm-opt], [$NMFLAGS])
-    echo "--readelf=$READELF" >> acargs
-    ADD_GHC_TOOLCHAIN_ARG([readelf-opt], [$READELFFLAGS])
+    # echo "--cc-link=$CC" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1])
+    # echo "--cxx=$CXX" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$CONF_CXX_OPTS_STAGE1])
+    # echo "--ar=$AR" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([ar-opt], [$ARFLAGS])
+    # echo "--ranlib=$RANLIB" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([ranlib-opt], [$RANLIBFLAGS])
+    # echo "--nm=$NM" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([nm-opt], [$NMFLAGS])
+    # echo "--readelf=$READELF" >> acargs
+    # ADD_GHC_TOOLCHAIN_ARG([readelf-opt], [$READELFFLAGS])
 
     ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised])
     ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode])
@@ -66,8 +69,19 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN],
     ) <acargs || exit 1
 
     cat acargs
-    cat default.target
+    cat default.ghc-toolchain.target
 
     #rm -Rf acargs acghc-toolchain actmp-ghc-toolchain
 ])
 
+
+AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[
+    A="default.target"
+    B="default.ghc-toolchain.target"
+    diff_output=`diff "$A" "$B" 2>&1`
+    if test -z "$diff_output"; then
+      true
+    else
+      AC_MSG_WARN([Differences found between $A and $B: $diff_output])
+    fi
+])


=====================================
m4/prep_target_file.m4
=====================================
@@ -0,0 +1,89 @@
+# PREP_BOOLEAN
+# ============
+#
+# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value
+# $1 = boolean variable to substitute
+AC_DEFUN([PREP_BOOLEAN],[
+    case "$$1" in
+        YES)
+          $1Bool=True
+          ;;
+        NO)
+          $1Bool=False
+          ;;
+        *)
+          AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1])
+          ;;
+    esac
+    AC_SUBST([$1Bool])
+])
+
+# PREP_LIST
+# ============
+#
+# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a
+# space-separated list of args
+# $1 = list variable to substitute
+dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'.
+AC_DEFUN([PREP_LIST],[
+    # shell array
+    set -- $$1
+    $1List="@<:@"
+    if test "[$]#" -eq 0; then
+        # no arguments
+        true
+    else
+        $1List="${$1List}\"[$]1\""
+        shift # drop first elem
+        for arg in "[$]@"
+        do
+            $1List="${$1List},\"$arg\""
+        done
+    fi
+    $1List="${$1List}@:>@"
+
+    AC_SUBST([$1List])
+])
+
+# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE
+# Prepares required substitutions to generate the target file
+AC_DEFUN([PREP_TARGET_FILE],[
+    PREP_BOOLEAN([LdSupportsResponseFiles])
+    PREP_BOOLEAN([TargetHasGnuNonexecStack])
+    PREP_BOOLEAN([LeadingUnderscore])
+    PREP_BOOLEAN([ArSupportsAtFile])
+    PREP_BOOLEAN([ArSupportsDashL])
+    PREP_BOOLEAN([TargetHasIdentDirective])
+    PREP_BOOLEAN([SettingsCCompilerSupportsNoPie])
+    PREP_BOOLEAN([LdHasFilelist])
+    PREP_BOOLEAN([LdIsGNULd])
+    PREP_BOOLEAN([LdHasNoCompactUnwind])
+    PREP_BOOLEAN([TargetHasSubsectionsViaSymbols])
+    PREP_BOOLEAN([Unregisterised])
+    PREP_BOOLEAN([TablesNextToCode])
+    PREP_BOOLEAN([UseLibffiForAdjustors])
+    PREP_BOOLEAN([ArIsGNUAr])
+    PREP_BOOLEAN([ArNeedsRanLib])
+    PREP_LIST([SettingsMergeObjectsFlags])
+    PREP_LIST([ArArgs])
+    PREP_LIST([SettingsCCompilerLinkFlags])
+    PREP_LIST([HaskellCPPArgs])
+    PREP_LIST([CONF_CPP_OPTS_STAGE1])
+    PREP_LIST([SettingsCxxCompilerFlags])
+    PREP_LIST([SettingsCCompilerFlags])
+    dnl PREP_ENDIANNESS
+    case "$TargetWordBigEndian" in
+        YES)
+            TargetEndianness=BigEndian
+            ;;
+        NO)
+            TargetEndianness=LittleEndian
+            ;;
+        *)
+            AC_MSG_ERROR([Expecting YES/NO but got $TargetWordBigEndian in TargetWordBigEndian])
+            ;;
+    esac
+    AC_SUBST([TargetEndianness])
+])
+
+AC_DEFUN()


=====================================
utils/ghc-toolchain/Main.hs
=====================================
@@ -160,9 +160,11 @@ options =
 
         -- Empty list of flags is as if it was unspecified
         updatePoFlags "" existingOpts      = existingOpts
-        -- Otherwise append specified flags to existing flags or make new
+        -- Otherwise prepend specified flags to existing flags or make new
         updatePoFlags newOpts Nothing      = Just [newOpts]
-        updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts])
+        updatePoFlags newOpts (Just eopts) = Just (newOpts:eopts)
+        -- NB: By prepending, the resulting flags will match the left-to-right
+        -- order they were passed in
 
 
     enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)]
@@ -216,7 +218,9 @@ run :: Opts -> M ()
 run opts = do
     tgt <- mkTarget opts
     logDebug $ "Final Target: " ++ show tgt
-    writeFile "default.target" (show tgt)
+    let file = "default.ghc-toolchain.target"
+    writeFile file (show tgt)
+    appendFile file "\n" -- eol
 
 optional :: M a -> M (Maybe a)
 optional k = fmap Just k <|> pure Nothing
@@ -295,18 +299,21 @@ mkTarget :: Opts -> M Target
 mkTarget opts = do
     let tgtLlvmTarget = optTriple opts
     cc0 <- findCc tgtLlvmTarget (optCc opts)
-    cxx <- findCxx (optCxx opts)
+    cxx <- findCxx tgtLlvmTarget (optCxx opts)
     cpp <- findCpp (optCpp opts) cc0
     hsCpp <- findHsCpp (optHsCpp opts) cc0
-    archOs <- parseTriple cc0 (optTriple opts)
+    (archOs, vendorName) <- parseTriple cc0 (optTriple opts)
     cc <- addPlatformDepCcFlags archOs cc0
     readelf <- optional $ findReadelf (optReadelf opts)
-    ccLink <- findCcLink (optCcLink opts) (optLdOverride opts) archOs cc readelf
+    ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (optLdOverride opts) archOs cc readelf
 
-    ar <- findAr (optAr opts)
-    ranlib <- if arNeedsRanlib ar
-                 then Just <$> findRanlib (optRanlib opts)
-                 else return Nothing
+    ar <- findAr vendorName (optAr opts)
+    -- TODO: We could have
+    -- ranlib <- if arNeedsRanlib ar
+    --              then Just <$> findRanlib (optRanlib opts)
+    --              else return Nothing
+    -- but in order to match the configure output, for now we do
+    ranlib <- Just <$> findRanlib (optRanlib opts)
 
     nm <- findNm (optNm opts)
     mergeObjs <- optional $ findMergeObjs (optMergeObjs opts) cc ccLink nm
@@ -327,7 +334,7 @@ mkTarget opts = do
     tgtWordSize <- checkWordSize cc
     tgtEndianness <- checkEndianness cc
     tgtSymbolsHaveLeadingUnderscore <- checkLeadingUnderscore cc nm
-    tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc
+    tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc
     tgtSupportsIdentDirective <- checkIdentDirective cc
     tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc
 
@@ -338,7 +345,7 @@ mkTarget opts = do
     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"
+        let prog = "int main(int argc, char** argv) { return 0; }"
             via_c_args = ["-fwrapv", "-fno-builtin"]
         forM_ via_c_args $ \arg -> checking ("support of "++arg) $ withTempDir $ \dir -> do
             let cc' = over (_ccProgram % _prgFlags) (++ [arg]) cc


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
=====================================
@@ -8,17 +8,18 @@ import GHC.Toolchain.Prelude
 import GHC.Toolchain.CheckArm
 import GHC.Toolchain.Tools.Cc
 
-parseTriple :: Cc -> String -> M ArchOS
+-- | Parse a triple `arch-vendor-os` into an 'ArchOS' and a vendor name 'String'
+parseTriple :: Cc -> String -> M (ArchOS, String)
 parseTriple cc triple
   | [archName, vendorName, osName] <- parts
   = do arch <- parseArch cc archName
        os <- parseOs vendorName osName
-       return $ ArchOS arch os
+       return $ (ArchOS arch os, vendorName)
 
   | [archName, vendorName, osName, _abi] <- parts
   = do arch <- parseArch cc archName
        os <- parseOs vendorName osName
-       return $ ArchOS arch os
+       return $ (ArchOS arch os, vendorName)
 
   | otherwise
   = throwE $ "malformed triple " ++ triple
@@ -37,6 +38,7 @@ parseArch cc arch =
       "s390x" -> pure ArchS390X
       "arm" -> findArmIsa cc
       _ | "armv" `isPrefixOf` arch -> findArmIsa cc
+      "arm64" -> pure ArchAArch64 -- TODO Should we support this alias or does this cause confusion?
       "aarch64" -> pure ArchAArch64
       "alpha" -> pure ArchAlpha
       "mips" -> pure ArchMipseb


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs
=====================================
@@ -102,11 +102,17 @@ checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do
     prog = "int func(void) { return 0; }"
     ctxt = "whether symbols have leading underscores"
 
-checkSubsectionsViaSymbols :: Cc -> M Bool
-checkSubsectionsViaSymbols =
-    testCompile
-      "whether .subsections-via-symbols directive is supported"
-      (asmStmt ".subsections_via_symbols")
+checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool
+checkSubsectionsViaSymbols archos cc =
+  case archOS_arch archos of
+    ArchAArch64 ->
+      -- subsections via symbols is busted on arm64
+      -- TODO: ^ is this comment up to date?
+      return False
+    _ ->
+      testCompile
+        "whether .subsections-via-symbols directive is supported"
+        (asmStmt ".subsections_via_symbols") cc
 
 checkIdentDirective :: Cc -> M Bool
 checkIdentDirective =


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
=====================================
@@ -13,12 +13,16 @@ module GHC.Toolchain.Program
     , _poPath
     , _poFlags
     , findProgram
+     -- * Compiler programs
+    , compile
+    , supportsTarget
     ) where
 
 import Control.Monad
 import Control.Monad.IO.Class
-import Data.List (intercalate)
+import Data.List (intercalate, isPrefixOf)
 import Data.Maybe
+import System.FilePath
 import System.Directory
 import System.Exit
 import System.Process hiding (env)
@@ -129,3 +133,39 @@ findProgram description userSpec candidates
           case r of
             Nothing -> throwE $ name ++ " not found in search path"
             Just x -> return x
+
+-------------------- Compiling utilities --------------------
+
+-- | Compile a program with a given compiler.
+--
+-- The compiler must
+-- * Take the program path as a positional argument
+-- * Accept -o to specify output path
+compile
+    :: FilePath  -- ^ input extension
+    -> [String]  -- ^ extra flags
+    -> Lens compiler Program
+    -> compiler
+    -> FilePath  -- ^ output path
+    -> String    -- ^ source
+    -> M ()
+compile ext extraFlags lens c outPath program = do
+    let srcPath = outPath <.> ext
+    writeFile srcPath program
+    callProgram (view lens c) $ extraFlags ++ ["-o", outPath, srcPath]
+    expectFileExists outPath "compiler produced no output"
+
+-- Does compiler program support the --target=<triple> option? If so, we should
+-- pass it whenever possible to avoid ambiguity and potential compile-time
+-- errors (e.g. see #20162).
+supportsTarget :: Lens compiler Program
+               -> (compiler -> M ()) -- ^ Action to check if compiler with --target flag works
+               -> String             -- ^ The llvm target to use if Cc supports --target
+               -> compiler           -- ^ The compiler to check --target support for
+               -> M compiler         -- ^ Return compiler with --target flag if supported
+supportsTarget lens checkWorks llvmTarget c
+  | any ("--target=" `isPrefixOf`) (view (lens % _prgFlags) c) = return c
+  | otherwise
+  = let c' = over (lens % _prgFlags) (("--target="++llvmTarget):) c
+     in (c' <$ checkWorks c') <|> return c
+


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 module GHC.Toolchain.Target where
 
 import GHC.Platform.ArchOS
@@ -60,7 +61,35 @@ data Target = Target
     , tgtDllwrap :: Maybe Program
     , tgtWindres :: Maybe Program
     }
-    deriving (Show, Read, Eq, Ord)
+    deriving (Read, Eq, Ord)
+
+instance Show Target where
+  show Target{..} = unlines
+    [ "Target"
+    , "{ tgtArchOs = " ++ show tgtArchOs
+    , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack
+    , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols
+    , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective
+    , ", tgtWordSize = " ++ show tgtWordSize
+    , ", tgtEndianness = " ++ show tgtEndianness
+    , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore
+    , ", tgtLlvmTarget = " ++ show tgtLlvmTarget
+    , ", tgtUnregisterised = " ++ show tgtUnregisterised
+    , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode
+    , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors
+    , ", tgtCCompiler = " ++ show tgtCCompiler
+    , ", tgtCxxCompiler = " ++ show tgtCxxCompiler
+    , ", tgtCPreprocessor = " ++ show tgtCPreprocessor
+    , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor
+    , ", tgtCCompilerLink = " ++ show tgtCCompilerLink
+    , ", tgtAr = " ++ show tgtAr
+    , ", tgtRanlib = " ++ show tgtRanlib
+    , ", tgtNm = " ++ show tgtNm
+    , ", tgtMergeObjs = " ++ show tgtMergeObjs
+    , ", tgtDllwrap = " ++ show tgtDllwrap
+    , ", tgtWindres = " ++ show tgtDllwrap
+    , "}"
+    ]
 
 -- | The word size as an integer representing the number of bytes
 wordSize2Bytes :: WordSize -> Int


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs
=====================================
@@ -17,10 +17,23 @@ data Ar = Ar { arMkArchive :: Program
              , arSupportsDashL :: Bool
              , arNeedsRanlib :: Bool
              }
-    deriving (Show, Read, Eq, Ord)
+    deriving (Read, Eq, Ord)
 
-findAr :: ProgOpt -> M Ar
-findAr progOpt = checking "for 'ar'" $ do
+-- These instances are more suitable for diffing
+instance Show Ar where
+  show Ar{..} = unlines
+    [ "Ar"
+    , "{ arMkArchive = " ++ show arMkArchive
+    , ", arIsGnu = " ++ show arIsGnu
+    , ", arSupportsAtFile = " ++ show arSupportsAtFile
+    , ", arSupportsDashL = " ++ show arSupportsDashL
+    , ", arNeedsRanlib = " ++ show arNeedsRanlib
+    , "}"
+    ]
+
+findAr :: String -- ^ Vendor name from the target triple
+       -> ProgOpt -> M Ar
+findAr vendor progOpt = checking "for 'ar'" $ do
     bareAr <- findProgram "ar archiver" progOpt ["ar"]
     arIsGnu <- ("GNU" `isInfixOf`) <$> readProgramStdout bareAr ["--version"]
 
@@ -32,7 +45,10 @@ findAr progOpt = checking "for 'ar'" $ do
     arSupportsDashL <- checkArSupportsDashL bareAr <|> return False
     let arNeedsRanlib
           | arIsGnu = False
-          -- TODO: Autoconf handles Apple specifically here
+          -- TODO: It'd be better not to handle Apple specifically here?
+          -- It's quite tedious to check for Apple's crazy timestamps in
+          -- .a files, so we hardcode it.
+          | vendor == "apple" = True
           | mode:_ <- prgFlags mkArchive
           , 's' `elem` mode = False
           | otherwise = True


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
=====================================
@@ -31,9 +31,11 @@ _ccProgram = Lens ccProgram (\x o -> o{ccProgram=x})
 findCc :: String -- ^ The llvm target to use if Cc supports --target
        -> ProgOpt -> M Cc
 findCc llvmTarget progOpt = checking "for C compiler" $ do
-    ccProgram <- findProgram "C compiler" progOpt ["cc", "clang", "gcc"]
+    -- TODO: We keep the candidate order we had in configure, but perhaps
+    -- there's a more optimal one
+    ccProgram <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"]
     cc' <- ignoreUnusedArgs $ Cc {ccProgram}
-    cc  <- supportsTarget llvmTarget cc'
+    cc  <- ccSupportsTarget llvmTarget cc'
     checkCcWorks cc
     checkC99Support cc
     checkCcSupportsExtraViaCFlags cc
@@ -54,18 +56,19 @@ checkCcWorks cc = withTempDir $ \dir -> do
 -- warnings from Clang. Clang offers the @-Qunused-arguments@ flag to silence
 -- these. See #11684.
 ignoreUnusedArgs :: Cc -> M Cc
-ignoreUnusedArgs cc = checking "for -Qunused-arguments support" $ do
-    let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc
-    (cc' <$ checkCcWorks cc') <|> return cc
-
--- Does CC support the --target=<triple> option? If so, we should pass it
+ignoreUnusedArgs cc
+  | "-Qunused-arguments" `elem` (view (_ccProgram % _prgFlags) cc) = return cc
+  | otherwise
+  = checking "for -Qunused-arguments support" $ do
+      let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc
+      (cc' <$ checkCcWorks cc') <|> return cc
+
+-- Does Cc support the --target=<triple> option? If so, we should pass it
 -- whenever possible to avoid ambiguity and potential compile-time errors (e.g.
 -- see #20162).
-supportsTarget :: String -- ^ The llvm target to use if Cc supports --target
-               -> Cc -> M Cc
-supportsTarget llvmTarget cc = checking "whether Cc supports --target" $ do
-    let cc' = over (_ccProgram % _prgFlags) (++["--target="++llvmTarget]) cc
-    (cc' <$ checkCcWorks cc') <|> return cc
+ccSupportsTarget :: String -> Cc -> M Cc
+ccSupportsTarget target cc = checking "whether Cc supports --target" $
+                             supportsTarget _ccProgram checkCcWorks target cc
 
 checkC99Support :: Cc -> M ()
 checkC99Support cc = checking "for C99 support" $ withTempDir $ \dir -> do
@@ -99,7 +102,7 @@ preprocess
     -> M String -- ^ preprocessed output
 preprocess cc prog = withTempDir $ \dir -> do
     let out = dir </> "test.c"
-    compile "c" ["-E"] cc out prog
+    compile "c" ["-E"] _ccProgram cc out prog
     readFile out
 
 -- | Compile a C source file to object code.
@@ -108,7 +111,7 @@ compileC
     -> FilePath -- ^ output path
     -> String   -- ^ C source
     -> M ()
-compileC = compile "c" ["-c"]
+compileC = compile "c" ["-c"] _ccProgram
 
 -- | Compile an assembler source file to object code.
 compileAsm
@@ -116,20 +119,7 @@ compileAsm
     -> FilePath -- ^ output path
     -> String   -- ^ Assembler source
     -> M ()
-compileAsm = compile "S" ["-c"]
-
-compile
-    :: FilePath  -- ^ input extension
-    -> [String]  -- ^ extra flags
-    -> Cc
-    -> FilePath  -- ^ output path
-    -> String    -- ^ source
-    -> M ()
-compile ext extraFlags cc outPath program = do
-    let srcPath = outPath <.> ext
-    writeFile srcPath program
-    callProgram (ccProgram cc) $ extraFlags ++ ["-o", outPath, srcPath]
-    expectFileExists outPath "compiler produced no output"
+compileAsm = compile "S" ["-c"] _ccProgram
 
 -- | Add various platform-dependent compiler flags needed by GHC. We can't do
 -- this in `findCc` since we need a 'Cc` to determine the 'ArchOS'.
@@ -146,3 +136,4 @@ checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works"
       let cc' = over (_ccProgram % _prgFlags) (++["-Wl,-fstack-checkzz"]) cc
       compileC cc' (dir </> "test.o") "int main(int argc, char **argv) { return 0; }"
       return cc'
+


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
=====================================
@@ -50,8 +50,8 @@ findHsCppArgs cpp = withTempDir $ \dir -> do
 
   writeFile tmp_h ""
   concat <$> sequence
-      [ ["-traditional"] <$ checkFlag "-traditional"
-      , tryFlag "-undef"
+      [ tryFlag "-undef"
+      , ["-traditional"] <$ checkFlag "-traditional"
       , tryFlag "-Wno-invalid-pp-token"
       , tryFlag "-Wno-unicode"
       , tryFlag "-Wno-trigraphs"


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs
=====================================
@@ -3,17 +3,49 @@
 module GHC.Toolchain.Tools.Cxx
     ( Cxx(..)
     , findCxx
+      -- * Helpful utilities
+    , compileCxx
     ) where
 
+import System.FilePath
 import GHC.Toolchain.Prelude
 import GHC.Toolchain.Program
+import GHC.Toolchain.Utils
 
 newtype Cxx = Cxx { cxxProgram :: Program
                   }
     deriving (Show, Read, Eq, Ord)
 
-findCxx :: ProgOpt -> M Cxx
-findCxx progOpt = checking "for C++ compiler" $ do
-    cxxProgram <- findProgram "C++ compiler" progOpt ["c++", "clang++", "g++"]
-    return $ Cxx {cxxProgram}
+_cxxProgram :: Lens Cxx Program
+_cxxProgram = Lens cxxProgram (\x o -> o{cxxProgram=x})
 
+findCxx :: String -- ^ The llvm target to use if Cc supports --target
+        -> ProgOpt -> M Cxx
+findCxx target progOpt = checking "for C++ compiler" $ do
+    -- TODO: We use the search order in configure, but there could be a more optimal one
+    cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"]
+    cxx        <- cxxSupportsTarget target Cxx{cxxProgram}
+    checkCxxWorks cxx
+    return cxx
+
+cxxSupportsTarget :: String -> Cxx -> M Cxx
+cxxSupportsTarget target cxx = checking "whether C++ supports --target" $
+                               supportsTarget _cxxProgram checkCxxWorks target cxx
+
+checkCxxWorks :: Cxx -> M ()
+checkCxxWorks cxx = withTempDir $ \dir -> do
+    let test_o = dir </> "test.o"
+    compileCxx cxx test_o $ unlines
+        [ "#include <stdio.h>"
+        , "int main(int argc, char **argv) {"
+        , "  printf(\"hello world!\");"
+        , "  return 0;"
+        , "}"
+        ]
+
+compileCxx
+    :: Cxx      -- ^ cxx
+    -> FilePath -- ^ output path
+    -> String   -- ^ C++ source
+    -> M ()
+compileCxx = compile "cpp" ["-c"] _cxxProgram


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -1,5 +1,6 @@
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE CPP #-}
 
 module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where
@@ -24,10 +25,27 @@ data CcLink = CcLink { ccLinkProgram :: Program
                      , ccLinkSupportsResponseFiles :: Bool
                      , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC
                      }
-    deriving (Show, Read, Eq, Ord)
-
-findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink
-findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do
+    deriving (Read, Eq, Ord)
+
+_ccLinkProgram :: Lens CcLink Program
+_ccLinkProgram = Lens ccLinkProgram (\x o -> o{ccLinkProgram=x})
+
+-- These instances are more suitable for diffing
+instance Show CcLink where
+  show CcLink{..} = unlines
+    [ "CcLink"
+    , "{ ccLinkProgram = " ++ show ccLinkProgram
+    , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie
+    , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind
+    , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist
+    , ", ccLinkSupportsResponseFiles = " ++  show ccLinkSupportsResponseFiles
+    , ", ccLinkIsGnu = " ++ show ccLinkIsGnu
+    , "}"
+    ]
+
+findCcLink :: String -- ^ The llvm target to use if CcLink supports --target
+           -> ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink
+findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do
   -- Use the specified linker or try to find one
   rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc]
   ccLinkProgram <- case poFlags progOpt of
@@ -44,7 +62,13 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l
   ccLinkIsGnu                 <- checkLinkIsGnu                ccLinkProgram
   checkBfdCopyBug archOs cc readelf ccLinkProgram
   ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram
-  return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles, ccLinkIsGnu}
+  let ccLink = CcLink {ccLinkProgram, ccLinkSupportsNoPie,
+                       ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist,
+                       ccLinkSupportsResponseFiles, ccLinkIsGnu}
+  ccLink <- linkSupportsTarget cc target ccLink
+  ccLink <- linkRequiresNoFixupChains archOs cc ccLink
+  return ccLink
+
 
 -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@
 findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program
@@ -71,6 +95,11 @@ findLinkFlags ldOverride cc ccLink
                        Just True  -> True
                        Just False -> False
 
+linkSupportsTarget :: Cc -> String -> CcLink -> M CcLink
+linkSupportsTarget cc target link
+  = checking "whether cc linker supports --target" $
+    supportsTarget _ccLinkProgram (checkLinkWorks cc . ccLinkProgram) target link
+
 -- | Should we attempt to find a more efficient linker on this platform?
 --
 -- N.B. On Darwin it is quite important that we use the system linker
@@ -95,12 +124,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $
     -- Check output as some GCC versions only warn and don't respect -Werror
     -- when passed an unrecognized flag.
     (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test]
-    if isSuccess code && "unrecognized" `isInfixOf` out
-      then return False
-      else return True
+    return (isSuccess code && not ("unrecognized" `isInfixOf` out))
 
 checkSupportsCompactUnwind :: Cc -> Program -> M Bool
 checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $
+  -- ROMES:TODO: This returns False here but True in configure because in
+  -- configure we check for ld supports compact unwind, whereas here we check
+  -- for cclink supports compact unwind... what do we need it for?
   withTempDir $ \dir -> do
     let test_o  = dir </> "test.o"
         test2_o = dir </> "test2.o"
@@ -108,7 +138,7 @@ checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understan
     compileC cc test_o "int foo() { return 0; }"
 
     exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o]
-    pure $ isSuccess exitCode
+    return $ isSuccess exitCode
 
 checkSupportsFilelist :: Cc -> Program -> M Bool
 checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $
@@ -121,15 +151,17 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f
     compileC cc test1_o "int foo() { return 0; }"
     compileC cc test2_o "int bar() { return 0; }"
 
-    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
+    --  write the filenames test1_o and test2_o to the test_ofiles file
+    writeFile  test_ofiles (unlines [test1_o,test2_o])
 
     exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o]
 
-    pure $ isSuccess exitCode
+    return (isSuccess exitCode)
 
 checkSupportsResponseFiles :: Cc -> Program -> M Bool
 checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $
+  -- ROMES:TODO: This returns True here while False in configure because in
+  -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink
   withTempDir $ \dir -> do
     let test_o = dir </> "test.o"
     compileC cc test_o "int main(void) {return 0;}"
@@ -141,7 +173,7 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports
     -- TODO: It'd be good to shortcircuit this logical `or`
     exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt]
     exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt]
-    pure (isSuccess exitCode1 || isSuccess exitCode2)
+    return (isSuccess exitCode1 || isSuccess exitCode2)
 
 -- | Check whether linking works.
 checkLinkWorks :: Cc -> Program -> M ()
@@ -236,3 +268,14 @@ addPlatformDepLinkFlags archOs cc ccLink
       return ccLink'
 
   | otherwise = return ccLink
+
+-- See if whether we are using a version of ld64 on darwin platforms which
+-- requires us to pass -no_fixup_chains
+linkRequiresNoFixupChains :: ArchOS -> Cc -> CcLink -> M CcLink
+linkRequiresNoFixupChains archOs cc ccLink
+  | OSDarwin <- archOS_OS archOs = checking "whether CC linker requires -no_fixup_chains" $
+      let ccLink' = over (_ccLinkProgram % _prgFlags) (++["-Wl,-no_fixup_chains"]) ccLink
+       in (ccLink' <$ checkLinkWorks cc (ccLinkProgram ccLink')) <|> return ccLink
+  | otherwise = return ccLink
+
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86b48e5e2e5c06d2ff69e113c5bc7cd0ee92b06a...e398306c264d98fa02eed082f275ced96da074a1

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86b48e5e2e5c06d2ff69e113c5bc7cd0ee92b06a...e398306c264d98fa02eed082f275ced96da074a1
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/20230606/f26e89f4/attachment-0001.html>


More information about the ghc-commits mailing list