[Git][ghc/ghc][wip/toolchain-selection] Address review
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Jul 17 19:35:22 UTC 2023
Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC
Commits:
5d6039a1 by Rodrigo Mesquita at 2023-07-17T20:34:34+01:00
Address review
Apply 10 suggestion(s) to 4 file(s)
Address review
- - - - -
8 changed files:
- − TODO
- hadrian/src/Rules/Generate.hs
- utils/ghc-toolchain/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Program.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 deleted
=====================================
@@ -1,9 +0,0 @@
-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)
-[x] 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)
-[ ] Write Note about dummy values in default.host.target
-[x] Don't put default.*.targets on the root folder.
-[x] The $$tooldir substitution didn't seem to be working when issued by hadrian.
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -532,7 +532,7 @@ generateSettings = do
mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) . tgtMergeObjs
-- Like @'queryTarget'@ specialized to String, but replace occurrences of
- -- @topDirectory </> inplace/mingw@ with @$$tooldir/mingw@ in the resulting string
+ -- @topDirectory </> inplace/mingw@ with @$tooldir/mingw@ in the resulting string
--
-- See Note [How we configure the bundled windows toolchain]
queryTarget' :: (Toolchain.Target -> String) -> Expr String
=====================================
utils/ghc-toolchain/Main.hs
=====================================
@@ -76,7 +76,7 @@ emptyOpts = Opts
, optUnregisterised = Nothing
, optTablesNextToCode = Nothing
, optUseLibFFIForAdjustors = Nothing
- , optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here?
+ , optLdOverride = Nothing
, optVerbosity = 1
, optKeepTemp = False
}
@@ -180,7 +180,7 @@ options =
]
tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple) "TRIPLE") "Target triple"
- llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVMTRIPLE") "LLVM Target triple"
+ llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVM-TRIPLE") "LLVM Target triple"
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"
@@ -299,8 +299,9 @@ determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for a
pure True
_ ->
-- If don't have a native adjustor implementation we use libffi
- pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we
+ pure (not . archHasNativeAdjustors $ archOS_arch archOs)
+-- | Do we implement a native adjustor implementation (i.e. found in @rts/adjustors@) for this 'Arch'?
archHasNativeAdjustors :: Arch -> Bool
archHasNativeAdjustors = \case
ArchX86 -> True
@@ -319,7 +320,7 @@ mkTarget opts = do
(archOs, tgtVendor) <- parseTriple cc0 (optTriple opts)
cc <- addPlatformDepCcFlags archOs cc0
readelf <- optional $ findReadelf (optReadelf opts)
- ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (optLdOverride opts) archOs cc readelf
+ ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (fromMaybe True (optLdOverride opts)) archOs cc readelf
ar <- findAr tgtVendor (optAr opts)
-- TODO: We could have
@@ -333,7 +334,7 @@ mkTarget opts = do
mergeObjs <- optional $ findMergeObjs (optMergeObjs opts) cc ccLink nm
when (isNothing mergeObjs && not (arSupportsDashL ar)) $
- throwE "Neither a merge object tool nor an ar that supports -L is available"
+ throwE "Neither a object-merging tool (e.g. ld -r) nor an ar that supports -L is available"
-- Windows-specific utilities
windres <-
@@ -377,9 +378,6 @@ mkTarget opts = do
, tgtRanlib = ranlib
, tgtNm = nm
, tgtMergeObjs = mergeObjs
- -- ROMES:TODO: Unfortunately these two don't yet mimic the
- -- logic in m4/fp_settings.m4 for windows variables
- -- In particular
, tgtWindres = windres
, tgtWordSize
, tgtEndianness
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
=====================================
@@ -85,7 +85,6 @@ checking what k = do
logInfo $ "checking " ++ what ++ "..."
r <- withLogContext ("checking " ++ what) k
logInfo $ "found " ++ what ++ ": " ++ show r
- -- ROMES:TODO: Otherwise print errors
return r
logDebug :: String -> M ()
@@ -104,7 +103,7 @@ logMsg v msg = do
readFile :: FilePath -> M String
readFile path = liftIO $ T.unpack <$> T.readFile path
-- Use T.readfile to read the file strictly, or otherwise run
- -- into bugs (in practice on windows)!
+ -- into file locking bugs on Windows
writeFile :: FilePath -> String -> M ()
writeFile path s = liftIO $ Prelude.writeFile path s
@@ -112,17 +111,11 @@ 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 ""
--- | Branch on whether we're cross-compiling, that is, if the Target we're
--- producing differs from the platform we're producing it on.
+-- | Branch on whether we can execute target code locally.
ifCrossCompiling
:: M a -- ^ what to do when cross-compiling
-> M a -- ^ what to do otherwise
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
=====================================
@@ -71,7 +71,8 @@ readProgram prog args = do
logExecute prog args
liftIO $ readProcessWithExitCode (prgPath prog) (prgFlags prog ++ args) ""
--- | Runs a program with a list of arguments and returns the stdout output
+-- | Runs a program with a list of arguments and returns the stdout output,
+-- ignoring the exit code.
readProgramStdout :: Program -> [String] -> M String
readProgramStdout prog args = do
logExecute prog args
@@ -140,7 +141,7 @@ findProgram description userSpec candidates
--
-- The compiler must
-- * Take the program path as a positional argument
--- * Accept -o to specify output path
+-- * Accept @-o@ to specify output path
compile
:: FilePath -- ^ input extension
-> [String] -- ^ extra flags
@@ -155,14 +156,14 @@ compile ext extraFlags lens c outPath program = do
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
+-- | 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
+ -> (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
-- TODO: #23603
| any ("--target=" `isPrefixOf`) (view (lens % _prgFlags) c) = return c
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
=====================================
@@ -22,22 +22,20 @@ data WordSize = WS4 | WS8
data Endianness = LittleEndian | BigEndian
deriving (Show, Read, Eq, Ord)
--- ROMES:TODO: A target might also need
--- * Llc command
--- * Opt command
--- * DistroMinGW? -- no, this should be configured with existing flags to point to the bindist mingw
--- * Install_name_tool
--- * Touch cmd
+-- TODO(#23674): Move the remaining relevant `settings-xxx` to Target:
+-- * llc command
+-- * opt command
+-- * install_name_tool
-- * otool command
--
--- Which are things that are put in GHC's settings, which might be different across targets
+-- Those are all things that are put into GHC's settings, and that might be
+-- different across targets
-- | A 'Target' consists of:
--
-- * a target architecture and operating system
-- * various bits of information about the platform
-- * various toolchain components targetting that platform
---
data Target = Target
{ -- Platform
tgtArchOs :: ArchOS
@@ -54,8 +52,9 @@ data Target = Target
-- GHC capabilities
, tgtUnregisterised :: Bool
, tgtTablesNextToCode :: Bool
- -- , 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
+ -- , tgtHasThreadedRts :: Bool -- We likely just need this 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
@@ -64,9 +63,11 @@ data Target = Target
, tgtHsCPreprocessor :: HsCpp
, tgtCCompilerLink :: CcLink
, tgtAr :: Ar
- , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it
+ , tgtRanlib :: Maybe Ranlib
+ -- ^ N.B. Most @ar@ implementations will add an index by default without @ranlib@ so this is often optional
, tgtNm :: Nm
- , tgtMergeObjs :: Maybe MergeObjs -- We don't need a merge objects tool if we @Ar@ supports @-L@
+ , tgtMergeObjs :: Maybe MergeObjs
+ -- ^ We don't need a merge objects tool if we @Ar@ supports @-L@
-- Windows-specific tools
, tgtWindres :: Maybe Program
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
=====================================
@@ -39,8 +39,12 @@ findCc llvmTarget progOpt = checking "for C compiler" $ do
-- there's a more optimal one
ccProgram' <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"]
- -- we inline the is-windows check here because we need Cc to call parseTriple
+ -- FIXME: This is a dreadful hack!
+ -- In reality, configure should pass these options to ghc-toolchain when
+ -- using the bundled windows toolchain, and ghc-toolchain should drop this around.
+ -- See #23678
let ccProgram = if "mingw32" `isInfixOf` llvmTarget && takeBaseName (prgPath ccProgram') == "clang"
+ -- we inline the is-windows check here because we need Cc to call parseTriple
then
-- Signal that we are linking against UCRT with the _UCRT macro. This is
-- necessary on windows clang to ensure correct behavior when
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -19,10 +19,10 @@ import GHC.Toolchain.Tools.Readelf
-- | Configuration on how the C compiler can be used to link
data CcLink = CcLink { ccLinkProgram :: Program
- , 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
- , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC
+ , ccLinkSupportsNoPie :: Bool -- See Note [No PIE when linking] in GHC.Driver.Session
+ , ccLinkSupportsCompactUnwind :: Bool
+ , ccLinkSupportsFilelist :: Bool
+ , ccLinkIsGnu :: Bool
}
deriving (Read, Eq, Ord)
@@ -42,7 +42,9 @@ _ccLinkProgram :: Lens CcLink Program
_ccLinkProgram = Lens ccLinkProgram (\x o -> o{ccLinkProgram=x})
findCcLink :: String -- ^ The llvm target to use if CcLink supports --target
- -> ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink
+ -> ProgOpt
+ -> Bool -- ^ Whether we should search for a more efficient linker
+ -> 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 [takeFileName $ prgPath $ ccProgram cc]
@@ -68,8 +70,8 @@ findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compile
-- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@
-findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program
-findLinkFlags ldOverride cc ccLink
+findLinkFlags :: Bool -> Cc -> Program -> M Program
+findLinkFlags enableOverride cc ccLink
| enableOverride && doLinkerSearch =
oneOf "this can't happen"
[ -- Annoyingly, gcc silently falls back to vanilla ld (typically bfd
@@ -84,13 +86,6 @@ findLinkFlags ldOverride cc ccLink
<|> (ccLink <$ checkLinkWorks cc ccLink)
| otherwise =
return ccLink
- where
- enableOverride = case ldOverride of
- -- ROMES: We're basically defining the default value here,
- -- wouldn't it be better to define the default on construction?
- Nothing -> True
- Just True -> True
- Just False -> False
linkSupportsTarget :: Cc -> String -> Program -> M Program
linkSupportsTarget cc target link
@@ -111,6 +106,7 @@ doLinkerSearch = True
doLinkerSearch = False
#endif
+-- | See Note [No PIE when linking] in GHC.Driver.Session
checkSupportsNoPie :: Program -> M Bool
checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $
withTempDir $ \dir -> do
@@ -120,8 +116,8 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $
let test = dir </> "test"
-- 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]
- return (isSuccess code && not ("unrecognized" `isInfixOf` out))
+ (code, out, err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test]
+ return (isSuccess code && not ("unrecognized" `isInfixOf` out) && not ("unrecognized" `isInfixOf` err))
-- ROMES:TODO: This check is wrong here and in configure because with ld.gold parses "-n" "o_compact_unwind"
-- TODO:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d6039a1170ce5889420b0f252153d87845cc862
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d6039a1170ce5889420b0f252153d87845cc862
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/20230717/6a24f8e9/attachment-0001.html>
More information about the ghc-commits
mailing list