[Git][ghc/ghc][wip/hadrian-cross-stage2] 3 commits: NM_STAGE0
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Fri Sep 22 08:32:26 UTC 2023
Matthew Pickering pushed to branch wip/hadrian-cross-stage2 at Glasgow Haskell Compiler / GHC
Commits:
bb59ccbd by GHC GitLab CI at 2023-09-21T15:37:22+00:00
NM_STAGE0
- - - - -
f8be1e3c by GHC GitLab CI at 2023-09-21T15:37:22+00:00
some succ stage
- - - - -
3b65ee6b by GHC GitLab CI at 2023-09-22T08:32:18+00:00
wip working
- - - - -
6 changed files:
- hadrian/cfg/default.host.target.in
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Builders/DeriveConstants.hs
- m4/fp_find_nm.m4
Changes:
=====================================
hadrian/cfg/default.host.target.in
=====================================
@@ -33,7 +33,7 @@ Target
}
, tgtRanlib = Nothing
-, tgtNm = Nm {nmProgram = Program {prgPath = "", prgFlags = []}}
+, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmdStage0@", prgFlags = []}}
, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False})
, tgtWindres = Nothing
}
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -22,6 +22,8 @@ import Hadrian.Oracles.TextFile
import Hadrian.Oracles.Path
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (runMaybeT)
+import Debug.Trace
+import GHC.Stack
import Base
@@ -248,11 +250,9 @@ libsuf st way
let suffix = waySuffix (removeWayUnit Dynamic way)
return (suffix ++ "-ghc" ++ version ++ extension)
+-- Build libraries for this stage targetting this Target
+-- For example, we want to build RTS with stage1 for the host target as we produce a host executable with stage1 (which cross-compiles to stage2)
targetStage :: Stage -> Action Target
--- TODO(#19174):
--- We currently only support cross-compiling a stage1 compiler,
--- but the cross compiler should really be stage2 (#19174).
--- When we get there, we'll need to change the definition here.
targetStage (Stage0 {}) = getHostTarget
targetStage (Stage1 {}) = getHostTarget
targetStage (Stage2 {}) = getTargetTarget
@@ -265,9 +265,10 @@ queryTargetTarget :: Stage -> (Target -> a) -> Action a
queryTargetTarget s f = f <$> targetStage s
-- | Whether the StageN compiler is a cross-compiler or not.
-crossStage :: Stage -> Action Bool
+crossStage :: HasCallStack => Stage -> Action Bool
crossStage st = do
- st_target <- targetStage st
- st_host <- targetStage (predStage st)
+ st_target <- targetStage (succStage st)
+ st_host <- targetStage st
+ traceShowM (targetPlatformTriple st_target, targetPlatformTriple st_host, st)
return (targetPlatformTriple st_target /= targetPlatformTriple st_host)
=====================================
hadrian/src/Packages.hs
=====================================
@@ -171,7 +171,7 @@ setPath pkg path = pkg { pkgPath = path }
crossPrefix :: Stage -> Action String
crossPrefix st = do
cross <- crossStage st
- targetPlatform <- targetPlatformTriple <$> targetStage st
+ targetPlatform <- targetPlatformTriple <$> targetStage (succStage st)
return $ if cross then targetPlatform ++ "-" else ""
-- | Given a 'Context', compute the name of the program that is built in it
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -383,14 +383,15 @@ generateGhcPlatformH = do
trackGenerateHs
stage <- getStage
let chooseSetting x y = case stage of { Stage0 {} -> x; _ -> y }
+ -- Not right for stage 3
buildPlatform <- chooseSetting (queryBuild targetPlatformTriple) (queryHost targetPlatformTriple)
buildArch <- chooseSetting (queryBuild queryArch) (queryHost queryArch)
buildOs <- chooseSetting (queryBuild queryOS) (queryHost queryOS)
buildVendor <- chooseSetting (queryBuild queryVendor) (queryHost queryVendor)
- hostPlatform <- chooseSetting (queryHost targetPlatformTriple) (queryTarget stage targetPlatformTriple)
- hostArch <- chooseSetting (queryHost queryArch) (queryTarget stage queryArch)
- hostOs <- chooseSetting (queryHost queryOS) (queryTarget stage queryOS)
- hostVendor <- chooseSetting (queryHost queryVendor) (queryTarget stage queryVendor)
+ hostPlatform <- queryTarget stage targetPlatformTriple
+ hostArch <- queryTarget stage queryArch
+ hostOs <- queryTarget stage queryOS
+ hostVendor <- queryTarget stage queryVendor
ghcUnreg <- queryTarget stage tgtUnregisterised
return . unlines $
[ "#if !defined(__GHCPLATFORM_H__)"
@@ -428,7 +429,7 @@ generateGhcPlatformH = do
generateSettings :: Expr String
generateSettings = do
ctx <- getContext
- stage <- getStage
+ stage <- succStage <$> getStage
settings <- traverse sequence $
[ ("C compiler command", queryTarget stage ccPath)
, ("C compiler flags", queryTarget stage ccFlags)
@@ -456,8 +457,7 @@ generateSettings = do
, ("touch command", expr $ settingsFileSetting ToolchainSetting_TouchCommand)
, ("windres command", queryTarget stage (maybe "/bin/false" prgPath . tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me.
, ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
--- MP: TODO wrong, needs to be per-stage
- , ("cross compiling", expr $ yesNo <$> flag CrossCompiling)
+ , ("cross compiling", expr $ yesNo <$> crossStage (predStage stage))
, ("target platform string", queryTarget stage targetPlatformTriple)
, ("target os", queryTarget stage (show . archOS_OS . tgtArchOs))
, ("target arch", queryTarget stage (show . archOS_arch . tgtArchOs))
@@ -520,8 +520,9 @@ generateConfigHs = do
stage <- getStage
let chooseSetting x y = case stage of { Stage0 {} -> x; _ -> y }
let queryTarget f = f <$> expr (targetStage stage)
+ -- Not right for stage3
buildPlatform <- chooseSetting (queryBuild targetPlatformTriple) (queryHost targetPlatformTriple)
- hostPlatform <- chooseSetting (queryHost targetPlatformTriple) (queryTarget targetPlatformTriple)
+ hostPlatform <- queryTarget targetPlatformTriple
trackGenerateHs
cProjectName <- getSetting ProjectName
cBooterVersion <- getSetting GhcVersion
=====================================
hadrian/src/Settings/Builders/DeriveConstants.hs
=====================================
@@ -20,7 +20,6 @@ deriveConstantsBuilderArgs = builder DeriveConstants ? do
cFlags <- includeCcArgs
outs <- getOutputs
stage <- getStage
- let stage = Stage1
let (outputFile, mode, tempDir) = case outs of
[ofile, mode, tmpdir] -> (ofile,mode,tmpdir)
[ofile, tmpdir]
@@ -46,10 +45,10 @@ includeCcArgs = do
rtsPath <- expr $ rtsBuildPath stage
mconcat [ cArgs
, cWarnings
- , prgFlags . ccProgram . tgtCCompiler <$> expr (targetStage Stage1)
- , queryTargetTarget Stage1 tgtUnregisterised ? arg "-DUSE_MINIINTERPRETER"
+ , prgFlags . ccProgram . tgtCCompiler <$> expr (targetStage stage)
+ , queryTargetTarget stage tgtUnregisterised ? arg "-DUSE_MINIINTERPRETER"
, arg "-Irts"
, arg "-Irts/include"
, arg $ "-I" ++ rtsPath </> "include"
- , notM (targetSupportsSMP Stage1) ? arg "-DNOSMP"
+ , notM (targetSupportsSMP stage) ? arg "-DNOSMP"
, arg "-fcommon" ]
=====================================
m4/fp_find_nm.m4
=====================================
@@ -11,6 +11,15 @@ AC_DEFUN([FP_FIND_NM],
fi
NmCmd="$NM"
AC_SUBST([NmCmd])
+ if test "$HostOS" != "mingw32"; then
+ AC_CHECK_TOOL([NM_STAGE0], [nm])
+ if test "$NM_STAGE0" = ":"; then
+ AC_MSG_ERROR([cannot find nm stage0 in your PATH])
+ fi
+ fi
+ NmCmdStage0="$NM_STAGE0"
+ AC_SUBST([NmCmdStage0])
+
if test "$TargetOS_CPP" = "darwin"
then
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25360e01ab155f59bf993779d337f6b66791bc6f...3b65ee6b81866bd8c2efded4bdd5ab0392d67ea4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25360e01ab155f59bf993779d337f6b66791bc6f...3b65ee6b81866bd8c2efded4bdd5ab0392d67ea4
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/20230922/d3e89059/attachment-0001.html>
More information about the ghc-commits
mailing list