Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
b96e2f77
by Sylvain Henry at 2025-04-18T20:46:33-04:00
-
6d9965f4
by Sylvain Henry at 2025-04-18T20:46:33-04:00
5 changed files:
- compiler/GHC/Driver/Session.hs
- configure.ac
- hadrian/src/Settings/Packages.hs
- rts/RtsUtils.c
- testsuite/ghc-config/ghc-config.hs
Changes:
| ... | ... | @@ -236,6 +236,7 @@ import GHC.Prelude |
| 236 | 236 | import GHC.Platform
|
| 237 | 237 | import GHC.Platform.Ways
|
| 238 | 238 | import GHC.Platform.Profile
|
| 239 | +import GHC.Platform.ArchOS
|
|
| 239 | 240 | |
| 240 | 241 | import GHC.Unit.Types
|
| 241 | 242 | import GHC.Unit.Parser
|
| ... | ... | @@ -3455,6 +3456,9 @@ compilerInfo dflags |
| 3455 | 3456 | ("Build platform", cBuildPlatformString),
|
| 3456 | 3457 | ("Host platform", cHostPlatformString),
|
| 3457 | 3458 | ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags),
|
| 3459 | + ("target os string", stringEncodeOS (platformOS (targetPlatform dflags))),
|
|
| 3460 | + ("target arch string", stringEncodeArch (platformArch (targetPlatform dflags))),
|
|
| 3461 | + ("target word size in bits", show (platformWordSizeInBits (targetPlatform dflags))),
|
|
| 3458 | 3462 | ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags),
|
| 3459 | 3463 | ("Object splitting supported", showBool False),
|
| 3460 | 3464 | ("Have native code generator", showBool $ platformNcgSupported platform),
|
| ... | ... | @@ -265,8 +265,8 @@ dnl we ask the bootstrapping compiler what platform it is for |
| 265 | 265 | |
| 266 | 266 | if test "${WithGhc}" != ""
|
| 267 | 267 | then
|
| 268 | - bootstrap_host=`"${WithGhc}" +RTS --info | grep '^ ,("Host platform"' | sed -e 's/.*, "//' -e 's/")//' | tr -d '\r'`
|
|
| 269 | - bootstrap_target=`"${WithGhc}" +RTS --info | grep '^ ,("Target platform"' | sed -e 's/.*, "//' -e 's/")//' | tr -d '\r'`
|
|
| 268 | + bootstrap_host=`"${WithGhc}" --info | grep '^ ,("Host platform"' | sed -e 's/.*,"//' -e 's/")//' | tr -d '\r'`
|
|
| 269 | + bootstrap_target=`"${WithGhc}" --info | grep '^ ,("Target platform"' | sed -e 's/.*,"//' -e 's/")//' | tr -d '\r'`
|
|
| 270 | 270 | if test "$bootstrap_host" != "$bootstrap_target"
|
| 271 | 271 | then
|
| 272 | 272 | echo "Bootstrapping GHC is a cross compiler. This probably isn't going to work"
|
| ... | ... | @@ -286,10 +286,6 @@ ghcInternalArgs = package ghcInternal ? do |
| 286 | 286 | rtsPackageArgs :: Args
|
| 287 | 287 | rtsPackageArgs = package rts ? do
|
| 288 | 288 | projectVersion <- getSetting ProjectVersion
|
| 289 | - hostPlatform <- queryHost targetPlatformTriple
|
|
| 290 | - hostArch <- queryHost queryArch
|
|
| 291 | - hostOs <- queryHost queryOS
|
|
| 292 | - hostVendor <- queryHost queryVendor
|
|
| 293 | 289 | buildPlatform <- queryBuild targetPlatformTriple
|
| 294 | 290 | buildArch <- queryBuild queryArch
|
| 295 | 291 | buildOs <- queryBuild queryOS
|
| ... | ... | @@ -371,18 +367,16 @@ rtsPackageArgs = package rts ? do |
| 371 | 367 | |
| 372 | 368 | , input "**/RtsUtils.c" ? pure
|
| 373 | 369 | [ "-DProjectVersion=" ++ show projectVersion
|
| 374 | - , "-DHostPlatform=" ++ show hostPlatform
|
|
| 375 | - , "-DHostArch=" ++ show hostArch
|
|
| 376 | - , "-DHostOS=" ++ show hostOs
|
|
| 377 | - , "-DHostVendor=" ++ show hostVendor
|
|
| 370 | + -- the RTS' host is the compiler's target (the target should be
|
|
| 371 | + -- per stage ideally...)
|
|
| 372 | + , "-DHostPlatform=" ++ show targetPlatform
|
|
| 373 | + , "-DHostArch=" ++ show targetArch
|
|
| 374 | + , "-DHostOS=" ++ show targetOs
|
|
| 375 | + , "-DHostVendor=" ++ show targetVendor
|
|
| 378 | 376 | , "-DBuildPlatform=" ++ show buildPlatform
|
| 379 | 377 | , "-DBuildArch=" ++ show buildArch
|
| 380 | 378 | , "-DBuildOS=" ++ show buildOs
|
| 381 | 379 | , "-DBuildVendor=" ++ show buildVendor
|
| 382 | - , "-DTargetPlatform=" ++ show targetPlatform
|
|
| 383 | - , "-DTargetArch=" ++ show targetArch
|
|
| 384 | - , "-DTargetOS=" ++ show targetOs
|
|
| 385 | - , "-DTargetVendor=" ++ show targetVendor
|
|
| 386 | 380 | , "-DGhcUnregisterised=" ++ show (yesNo ghcUnreg)
|
| 387 | 381 | , "-DTablesNextToCode=" ++ show (yesNo ghcEnableTNC)
|
| 388 | 382 | , "-DRtsWay=\"rts_" ++ show way ++ "\""
|
| ... | ... | @@ -364,18 +364,10 @@ void printRtsInfo(const RtsConfig rts_config) { |
| 364 | 364 | printf(" [(\"GHC RTS\", \"YES\")\n");
|
| 365 | 365 | mkRtsInfoPair("GHC version", ProjectVersion);
|
| 366 | 366 | mkRtsInfoPair("RTS way", RtsWay);
|
| 367 | - mkRtsInfoPair("Build platform", BuildPlatform);
|
|
| 368 | - mkRtsInfoPair("Build architecture", BuildArch);
|
|
| 369 | - mkRtsInfoPair("Build OS", BuildOS);
|
|
| 370 | - mkRtsInfoPair("Build vendor", BuildVendor);
|
|
| 371 | 367 | mkRtsInfoPair("Host platform", HostPlatform);
|
| 372 | 368 | mkRtsInfoPair("Host architecture", HostArch);
|
| 373 | 369 | mkRtsInfoPair("Host OS", HostOS);
|
| 374 | 370 | mkRtsInfoPair("Host vendor", HostVendor);
|
| 375 | - mkRtsInfoPair("Target platform", TargetPlatform);
|
|
| 376 | - mkRtsInfoPair("Target architecture", TargetArch);
|
|
| 377 | - mkRtsInfoPair("Target OS", TargetOS);
|
|
| 378 | - mkRtsInfoPair("Target vendor", TargetVendor);
|
|
| 379 | 371 | mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS));
|
| 380 | 372 | // TODO(@Ericson2314) This is a joint property of the RTS and generated
|
| 381 | 373 | // code. The compiler will soon be multi-target so it doesn't make sense to
|
| 1 | 1 | import System.Environment
|
| 2 | 2 | import System.Process
|
| 3 | 3 | import Data.Maybe
|
| 4 | +import Control.Monad
|
|
| 4 | 5 | |
| 5 | 6 | main :: IO ()
|
| 6 | 7 | main = do
|
| ... | ... | @@ -9,15 +10,25 @@ main = do |
| 9 | 10 | info <- readProcess ghc ["+RTS", "--info"] ""
|
| 10 | 11 | let fields = read info :: [(String,String)]
|
| 11 | 12 | getGhcFieldOrFail fields "HostOS" "Host OS"
|
| 12 | - getGhcFieldOrFail fields "WORDSIZE" "Word size"
|
|
| 13 | - getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
|
|
| 14 | - getGhcFieldOrFail fields "TargetOS_CPP" "Target OS"
|
|
| 15 | - getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture"
|
|
| 16 | 13 | getGhcFieldOrFail fields "RTSWay" "RTS way"
|
| 17 | 14 | |
| 15 | + -- support for old GHCs (pre 9.13): infer target platform by querying the rts...
|
|
| 16 | + let query_rts = isJust (lookup "Target platform" fields)
|
|
| 17 | + when query_rts $ do
|
|
| 18 | + getGhcFieldOrFail fields "WORDSIZE" "Word size"
|
|
| 19 | + getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
|
|
| 20 | + getGhcFieldOrFail fields "TargetOS_CPP" "Target OS"
|
|
| 21 | + getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture"
|
|
| 22 | + |
|
| 18 | 23 | info <- readProcess ghc ["--info"] ""
|
| 19 | 24 | let fields = read info :: [(String,String)]
|
| 20 | 25 | |
| 26 | + unless query_rts $ do
|
|
| 27 | + getGhcFieldOrFail fields "WORDSIZE" "target word size in bits"
|
|
| 28 | + getGhcFieldOrFail fields "TARGETPLATFORM" "target platform string"
|
|
| 29 | + getGhcFieldOrFail fields "TargetOS_CPP" "target os string"
|
|
| 30 | + getGhcFieldOrFail fields "TargetARCH_CPP" "target arch string"
|
|
| 31 | + |
|
| 21 | 32 | getGhcFieldOrFail fields "GhcStage" "Stage"
|
| 22 | 33 | getGhcFieldOrFail fields "GhcDebugAssertions" "Debug on"
|
| 23 | 34 | getGhcFieldOrFail fields "GhcWithNativeCodeGen" "Have native code generator"
|