Commit dd8f76b2 authored by John Ericson's avatar John Ericson Committed by Marge Bot

Factor out a smaller part of Platform for host fallback

parent b538476b
......@@ -372,12 +372,14 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
checkArch "$HostArch" "HaskellHostArch"
checkVendor "$HostVendor"
checkOS "$HostOS" ""
checkOS "$HostOS" "HaskellHostOs"
checkArch "$TargetArch" "HaskellTargetArch"
checkVendor "$TargetVendor"
checkOS "$TargetOS" "HaskellTargetOs"
AC_SUBST(HaskellHostArch)
AC_SUBST(HaskellHostOs)
AC_SUBST(HaskellTargetArch)
AC_SUBST(HaskellTargetOs)
AC_SUBST(TargetHasSubsectionsViaSymbols)
......
......@@ -1512,7 +1512,7 @@ versionedAppDir dflags = do
return $ appdir </> versionedFilePath dflags
versionedFilePath :: DynFlags -> FilePath
versionedFilePath dflags = uniqueSubdir $ targetPlatform dflags
versionedFilePath dflags = uniqueSubdir $ platformMini $ targetPlatform dflags
-- | The target code type of the compilation (if any).
--
......
......@@ -565,7 +565,7 @@ pprGotDeclaration _ _ _
--
pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
pprImportedSymbol dflags (Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
pprImportedSymbol dflags (Platform { platformMini = PlatformMini { platformMini_arch = ArchX86, platformMini_os = OSDarwin } }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case positionIndependent dflags of
False ->
......@@ -618,7 +618,7 @@ pprImportedSymbol dflags (Platform { platformArch = ArchX86, platformOS = OSDarw
= empty
pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
pprImportedSymbol _ (Platform { platformMini = PlatformMini { platformMini_os = OSDarwin } }) _
= empty
-- XCOFF / AIX
......@@ -632,7 +632,7 @@ pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
--
-- NB: No DSO-support yet
pprImportedSymbol dflags (Platform { platformOS = OSAIX }) importedLbl
pprImportedSymbol dflags (Platform { platformMini = PlatformMini { platformMini_os = OSAIX } }) importedLbl
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> vcat [
......@@ -669,7 +669,7 @@ pprImportedSymbol dflags (Platform { platformOS = OSAIX }) importedLbl
-- the NCG will keep track of all DynamicLinkerLabels it uses
-- and output each of them using pprImportedSymbol.
pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC_64 _ })
pprImportedSymbol dflags platform@(Platform { platformMini = PlatformMini { platformMini_arch = ArchPPC_64 _ } })
importedLbl
| osElfTarget (platformOS platform)
= case dynamicLinkerLabelInfo importedLbl of
......
......@@ -60,12 +60,16 @@ host-platform = @HostPlatform@
host-arch = @HostArch_CPP@
host-os = @HostOS_CPP@
host-vendor = @HostVendor_CPP@
host-os-haskell = @HaskellHostOs@
host-arch-haskell = @HaskellHostArch@
target-platform = @TargetPlatform@
target-platform-full = @TargetPlatformFull@
target-arch = @TargetArch_CPP@
target-os = @TargetOS_CPP@
target-vendor = @TargetVendor_CPP@
target-os-haskell = @HaskellTargetOs@
target-arch-haskell = @HaskellTargetArch@
llvm-target = @LLVMTarget_CPP@
cross-compiling = @CrossCompiling@
......@@ -143,8 +147,6 @@ settings-clang-command = @SettingsClangCommand@
settings-llc-command = @SettingsLlcCommand@
settings-opt-command = @SettingsOptCommand@
haskell-target-os = @HaskellTargetOs@
haskell-target-arch = @HaskellTargetArch@
target-word-size = @TargetWordSize@
target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@
target-has-ident-directive = @TargetHasIdentDirective@
......
......@@ -42,6 +42,8 @@ data Setting = BuildArch
| HostOs
| HostPlatform
| HostVendor
| HostArchHaskell
| HostOsHaskell
| IconvIncludeDir
| IconvLibDir
| LlvmTarget
......@@ -58,6 +60,8 @@ data Setting = BuildArch
| TargetPlatform
| TargetPlatformFull
| TargetVendor
| TargetArchHaskell
| TargetOsHaskell
-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
-- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@,
......@@ -126,6 +130,8 @@ setting key = lookupValueOrError configFile $ case key of
HostOs -> "host-os"
HostPlatform -> "host-platform"
HostVendor -> "host-vendor"
HostArchHaskell -> "host-arch-haskell"
HostOsHaskell -> "host-os-haskell"
IconvIncludeDir -> "iconv-include-dir"
IconvLibDir -> "iconv-lib-dir"
LlvmTarget -> "llvm-target"
......@@ -142,6 +148,8 @@ setting key = lookupValueOrError configFile $ case key of
TargetPlatform -> "target-platform"
TargetPlatformFull -> "target-platform-full"
TargetVendor -> "target-vendor"
TargetArchHaskell -> "target-arch-haskell"
TargetOsHaskell -> "target-os-haskell"
-- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
-- result.
......
......@@ -119,8 +119,9 @@ generatePackageCode context@(Context stage pkg _) = do
when (pkg == ghcPrim) $ do
root -/- "**" -/- dir -/- "GHC/Prim.hs" %> genPrimopCode context
root -/- "**" -/- dir -/- "GHC/PrimopWrappers.hs" %> genPrimopCode context
when (pkg == ghcBoot) $
when (pkg == ghcBoot) $ do
root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs
root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs
when (pkg == compiler) $ do
root -/- primopsTxt stage %> \file -> do
......@@ -296,8 +297,8 @@ generateSettings = do
, ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
, ("cross compiling", expr $ yesNo <$> flag CrossCompiling)
, ("target platform string", getSetting TargetPlatform)
, ("target os", expr $ lookupValueOrError configFile "haskell-target-os")
, ("target arch", expr $ lookupValueOrError configFile "haskell-target-arch")
, ("target os", getSetting TargetOsHaskell)
, ("target arch", getSetting TargetArchHaskell)
, ("target word size", expr $ lookupValueOrError configFile "target-word-size")
, ("target has GNU nonexec stack", expr $ lookupValueOrError configFile "target-has-gnu-nonexec-stack")
, ("target has .ident directive", expr $ lookupValueOrError configFile "target-has-ident-directive")
......@@ -461,3 +462,27 @@ generateVersionHs = do
, "cProjectPatchLevel2 :: String"
, "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2
]
-- | Generate @Platform/Host.hs@ files.
generatePlatformHostHs :: Expr String
generatePlatformHostHs = do
trackGenerateHs
cHostPlatformArch <- getSetting HostArchHaskell
cHostPlatformOS <- getSetting HostOsHaskell
return $ unlines
[ "module GHC.Platform.Host where"
, ""
, "import GHC.Platform"
, ""
, "cHostPlatformArch :: Arch"
, "cHostPlatformArch = " ++ cHostPlatformArch
, ""
, "cHostPlatformOS :: OS"
, "cHostPlatformOS = " ++ cHostPlatformOS
, ""
, "cHostPlatformMini :: PlatformMini"
, "cHostPlatformMini = PlatformMini"
, " { platformMini_arch = cHostPlatformArch"
, " , platformMini_os = cHostPlatformOS"
, " }"
]
......@@ -3,8 +3,9 @@
-- | A description of the platform we're compiling for.
--
module GHC.Platform (
Platform(..),
PlatformMini(..),
PlatformWordSize(..),
Platform(..), platformArch, platformOS,
Arch(..),
OS(..),
ArmISA(..),
......@@ -33,12 +34,21 @@ where
import Prelude -- See Note [Why do we import Prelude here?]
import GHC.Read
-- | Contains the bare-bones arch and os information. This isn't enough for
-- code gen, but useful for tasks where we can fall back upon the host
-- platform, as this is all we know about the host platform.
data PlatformMini
= PlatformMini
{ platformMini_arch :: Arch
, platformMini_os :: OS
}
deriving (Read, Show, Eq)
-- | Contains enough information for the native code generator to emit
-- code for this platform.
data Platform
= Platform {
platformArch :: Arch,
platformOS :: OS,
platformMini :: PlatformMini,
-- Word size in bytes (i.e. normally 4 or 8,
-- for 32bit and 64bit platforms respectively)
platformWordSize :: PlatformWordSize,
......@@ -76,6 +86,14 @@ platformWordSizeInBytes p =
platformWordSizeInBits :: Platform -> Int
platformWordSizeInBits p = platformWordSizeInBytes p * 8
-- | Legacy accessor
platformArch :: Platform -> Arch
platformArch = platformMini_arch . platformMini
-- | Legacy accessor
platformOS :: Platform -> OS
platformOS = platformMini_os . platformMini
-- | Architectures that the native code generator knows about.
-- TODO: It might be nice to extend these constructors with information
-- about what instruction set extensions an architecture might support.
......
......@@ -43,8 +43,10 @@ getTargetPlatform settingsFile mySettings = do
crossCompiling <- getBooleanSetting "cross compiling"
pure $ Platform
{ platformArch = targetArch
, platformOS = targetOS
{ platformMini = PlatformMini
{ platformMini_arch = targetArch
, platformMini_os = targetOS
}
, platformWordSize = targetWordSize
, platformUnregisterised = targetUnregisterised
, platformHasGnuNonexecStack = targetHasGnuNonexecStack
......
module GHC.UniqueSubdir
( uniqueSubdir
, uniqueSubdir0
) where
import Prelude -- See Note [Why do we import Prelude here?]
......@@ -13,18 +12,13 @@ import GHC.Version (cProjectVersion)
-- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when
-- constructing platform-version-dependent files that need to co-exist.
--
uniqueSubdir :: Platform -> FilePath
uniqueSubdir platform = uniqueSubdir0
(stringEncodeArch $ platformArch platform)
(stringEncodeOS $ platformOS platform)
-- | 'ghc-pkg' falls back on the host platform if the settings file is missing,
-- 'ghc-pkg' falls back on the host platform if the settings file is missing,
-- and so needs this since we don't have information about the host platform in
-- as much detail as 'Platform'.
uniqueSubdir0 :: String -> String -> FilePath
uniqueSubdir0 arch os = intercalate "-"
[ arch
-- as much detail as 'Platform', so we use 'PlatformMini' instead.
uniqueSubdir :: PlatformMini -> FilePath
uniqueSubdir archOs = intercalate "-"
[ stringEncodeArch $ platformMini_arch archOs
, stringEncodeOS $ platformMini_os archOs
, cProjectVersion
]
-- NB: This functionality is reimplemented in Cabal, so if you
......
......@@ -44,6 +44,7 @@ Library
GHC.ForeignSrcLang
GHC.HandleEncoding
GHC.Platform
GHC.Platform.Host
GHC.Settings
GHC.UniqueSubdir
GHC.Version
......@@ -51,6 +52,7 @@ Library
-- but done by Hadrian
-- autogen-modules:
-- GHC.Version
-- GHC.Platform.Host
build-depends: base >= 4.7 && < 4.14,
binary == 0.8.*,
......
......@@ -34,3 +34,28 @@ libraries/ghc-boot/dist-boot/package-data.mk: \
libraries/ghc-boot/dist-boot/build/GHC/Version.hs
libraries/ghc-boot/dist-install/package-data.mk: \
libraries/ghc-boot/dist-install/build/GHC/Version.hs
libraries/ghc-boot/dist-boot/build/GHC/Platform/Host.hs \
libraries/ghc-boot/dist-install/build/GHC/Platform/Host.hs: mk/project.mk | $$(dir $$@)/.
$(call removeFiles,$@)
@echo "module GHC.Platform.Host where" >> $@
@echo >> $@
@echo 'import GHC.Platform' >> $@
@echo >> $@
@echo 'cHostPlatformArch :: Arch' >> $@
@echo 'cHostPlatformArch = $(HaskellHostArch)' >> $@
@echo >> $@
@echo 'cHostPlatformOS :: OS' >> $@
@echo 'cHostPlatformOS = $(HaskellHostOs)' >> $@
@echo >> $@
@echo 'cHostPlatformMini :: PlatformMini' >> $@
@echo 'cHostPlatformMini = PlatformMini' >> $@
@echo ' { platformMini_arch = cHostPlatformArch' >> $@
@echo ' , platformMini_os = cHostPlatformOS' >> $@
@echo ' }' >> $@
@echo done.
libraries/ghc-boot/dist-boot/package-data.mk: \
libraries/ghc-boot/dist-boot/build/GHC/Platform/Host.hs
libraries/ghc-boot/dist-install/package-data.mk: \
libraries/ghc-boot/dist-install/build/GHC/Platform/Host.hs
......@@ -486,6 +486,8 @@ GHC_PACKAGE_DB_FLAG = @GHC_PACKAGE_DB_FLAG@
GccExtraViaCOpts = @GccExtraViaCOpts@
LdHasFilelist = @LdHasFilelist@
ArArgs = @ArArgs@
HaskellHostOs = @HaskellHostOs@
HaskellHostArch = @HaskellHostArch@
HaskellTargetOs = @HaskellTargetOs@
HaskellTargetArch = @HaskellTargetArch@
TargetWordSize = @TargetWordSize@
......
......@@ -35,13 +35,9 @@ import GHC.PackageDb (BinaryStringRep(..))
import GHC.HandleEncoding
import GHC.BaseDir (getBaseDir)
import GHC.Settings (getTargetPlatform, maybeReadFuzzy)
import GHC.Platform
( platformArch, platformOS
, stringEncodeArch, stringEncodeOS
)
import GHC.UniqueSubdir
( uniqueSubdir0
)
import GHC.Platform (platformMini)
import GHC.Platform.Host (cHostPlatformMini)
import GHC.UniqueSubdir (uniqueSubdir)
import GHC.Version ( cProjectVersion )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import qualified Data.Graph as Graph
......@@ -642,11 +638,11 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- See Note [Settings File] about this file, and why we need GHC to share it with us.
let settingsFile = top_dir </> "settings"
exists_settings_file <- doesFileExist settingsFile
(arch, os) <- case exists_settings_file of
targetPlatformMini <- case exists_settings_file of
False -> do
warn $ "WARNING: settings file doesn't exist " ++ show settingsFile
warn "cannot know target platform so guessing target == host (native compiler)."
pure (HOST_ARCH, HOST_OS)
pure cHostPlatformMini
True -> do
settingsStr <- readFile settingsFile
mySettings <- case maybeReadFuzzy settingsStr of
......@@ -655,9 +651,9 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- least) but completely inexcusable to have a malformed one.
Nothing -> die $ "Can't parse settings file " ++ show settingsFile
case getTargetPlatform settingsFile mySettings of
Right platform -> pure (stringEncodeArch $ platformArch platform, stringEncodeOS $ platformOS platform)
Right platform -> pure $ platformMini platform
Left e -> die e
let subdir = uniqueSubdir0 arch os
let subdir = uniqueSubdir targetPlatformMini
dir = appdir </> subdir
r <- lookForPackageDBIn dir
case r of
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment