Commit 6333d739 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

Put PlatformConstants into Platform

parent 342a01af
......@@ -551,7 +551,7 @@ funInfoArity dflags iptr
| otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc
, oFFSET_StgFunInfoExtraFwd_arity dflags )
pc = platformConstants dflags
pc = platformConstants platform
-----------------------------------------------------------------------------
--
......
......@@ -326,22 +326,22 @@ data ForeignHint
rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType
rEP_CostCentreStack_mem_alloc dflags
= cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc))
where pc = platformConstants dflags
where pc = platformConstants (targetPlatform dflags)
rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
rEP_CostCentreStack_scc_count dflags
= cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc))
where pc = platformConstants dflags
where pc = platformConstants (targetPlatform dflags)
rEP_StgEntCounter_allocs :: DynFlags -> CmmType
rEP_StgEntCounter_allocs dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
where pc = platformConstants dflags
where pc = platformConstants (targetPlatform dflags)
rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
where pc = platformConstants dflags
where pc = platformConstants (targetPlatform dflags)
-------------------------------------------------------------------------
{- Note [Signed vs unsigned]
......
......@@ -464,7 +464,6 @@ data DynFlags = DynFlags {
targetPlatform :: Platform, -- Filled in by SysTools
toolSettings :: {-# UNPACK #-} !ToolSettings,
platformMisc :: {-# UNPACK #-} !PlatformMisc,
platformConstants :: PlatformConstants,
rawSettings :: [(String, String)],
llvmConfig :: LlvmConfig,
......@@ -911,7 +910,7 @@ settings dflags = Settings
, sTargetPlatform = targetPlatform dflags
, sToolSettings = toolSettings dflags
, sPlatformMisc = platformMisc dflags
, sPlatformConstants = platformConstants dflags
, sPlatformConstants = platformConstants (targetPlatform dflags)
, sRawSettings = rawSettings dflags
}
......@@ -1331,7 +1330,6 @@ defaultDynFlags mySettings llvmConfig =
toolSettings = sToolSettings mySettings,
targetPlatform = sTargetPlatform mySettings,
platformMisc = sPlatformMisc mySettings,
platformConstants = sPlatformConstants mySettings,
rawSettings = sRawSettings mySettings,
-- See Note [LLVM configuration].
......
......@@ -6,7 +6,6 @@ module GHC.Settings
, ToolSettings (..)
, FileSettings (..)
, GhcNameVersion (..)
, PlatformConstants (..)
, Platform (..)
, PlatformMisc (..)
, PlatformMini (..)
......@@ -158,10 +157,6 @@ data GhcNameVersion = GhcNameVersion
, ghcNameVersion_projectVersion :: String
}
-- Produced by deriveConstants
-- Provides PlatformConstants datatype
#include "GHCConstantsHaskellType.hs"
-----------------------------------------------------------------------------
-- Accessessors from 'Settings'
......
......@@ -92,7 +92,7 @@ initSettings top_dir = do
cpp_prog <- getToolSetting "Haskell CPP command"
cpp_args_str <- getSetting "Haskell CPP flags"
platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings
platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings platformConstants
let unreg_cc_args = if platformUnregisterised platform
then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
......
......@@ -119,6 +119,7 @@ generatePackageCode context@(Context stage pkg _) = do
when (pkg == ghcBoot) $ do
root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs
root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs
root -/- "**" -/- dir -/- "GHC/Platform/Constants.hs" %> genPlatformConstantsType context
when (pkg == compiler) $ do
root -/- primopsTxt stage %> \file -> do
......@@ -145,6 +146,11 @@ genPrimopCode context@(Context stage _pkg _) file = do
need [root -/- primopsTxt stage]
build $ target context GenPrimopCode [root -/- primopsTxt stage] [file]
genPlatformConstantsType :: Context -> FilePath -> Action ()
genPlatformConstantsType context file = do
withTempDir $ \tmpdir ->
build $ target context DeriveConstants [] [file,"--gen-haskell-type",tmpdir]
copyRules :: Rules ()
copyRules = do
root <- buildRootRules
......
......@@ -19,12 +19,16 @@ deriveConstantsBuilderArgs :: Args
deriveConstantsBuilderArgs = builder DeriveConstants ? do
cFlags <- includeCcArgs
outs <- getOutputs
let (outputFile, tempDir) = case outs of
[a, b] -> (a, b)
_ -> error $ "DeriveConstants: expected two outputs, got " ++ show outs
let (outputFile, mode, tempDir) = case outs of
[ofile, mode, tmpdir] -> (ofile,mode,tmpdir)
[ofile, tmpdir]
| Just mode <- lookup (takeFileName ofile) deriveConstantsPairs
-> (ofile, mode, tmpdir)
| otherwise
-> error $ "DeriveConstants: invalid output file, got " ++ show (takeFileName ofile)
_ -> error $ "DeriveConstants: unexpected outputs, got " ++ show outs
mconcat
[ mconcat $ flip fmap deriveConstantsPairs $ \(fileName, flag) ->
output ("//" ++ fileName) ? arg flag
[ arg mode
, arg "-o", arg outputFile
, arg "--tmpdir", arg tempDir
, arg "--gcc-program", arg =<< getBuilderPath (Cc CompileC Stage1)
......
......@@ -5,6 +5,7 @@
module GHC.Platform
( PlatformMini(..)
, PlatformWordSize(..)
, PlatformConstants(..)
, Platform(..)
, platformArch
, platformOS
......@@ -39,6 +40,7 @@ where
import Prelude -- See Note [Why do we import Prelude here?]
import GHC.Read
import GHC.ByteOrder (ByteOrder(..))
import GHC.Platform.Constants
import Data.Word
import Data.Int
......@@ -68,6 +70,8 @@ data Platform = Platform
-- ^ Determines whether we will be compiling info tables that reside just
-- before the entry code, or with an indirection to the entry code. See
-- TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.
, platformConstants :: !PlatformConstants
-- ^ Constants such as structure offsets, type sizes, etc.
}
deriving (Read, Show, Eq)
......
......@@ -26,8 +26,11 @@ import qualified Data.Map as Map
-- parts of settings file
getTargetPlatform
:: FilePath -> RawSettings -> Either String Platform
getTargetPlatform settingsFile mySettings = do
:: FilePath -- ^ Settings filepath (for error messages)
-> RawSettings -- ^ Raw settings file contents
-> PlatformConstants -- ^ Platform constants
-> Either String Platform
getTargetPlatform settingsFile mySettings constants = do
let
getBooleanSetting = getBooleanSetting0 settingsFile mySettings
readSetting :: (Show a, Read a) => String -> Either String a
......@@ -59,6 +62,7 @@ getTargetPlatform settingsFile mySettings = do
, platformIsCrossCompiling = crossCompiling
, platformLeadingUnderscore = targetLeadingUnderscore
, platformTablesNextToCode = tablesNextToCode
, platformConstants = constants
}
-----------------------------------------------------------------------------
......
......@@ -45,6 +45,7 @@ Library
GHC.HandleEncoding
GHC.Platform
GHC.Platform.Host
GHC.Platform.Constants
GHC.Settings.Platform
GHC.Settings.Utils
GHC.UniqueSubdir
......@@ -54,6 +55,7 @@ Library
-- autogen-modules:
-- GHC.Version
-- GHC.Platform.Host
-- GHC.Platform.Constants
build-depends: base >= 4.7 && < 4.16,
binary == 0.8.*,
......
......@@ -873,8 +873,10 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
writeHaskellType :: FilePath -> [What Fst] -> IO ()
writeHaskellType fn ws = writeFile fn xs
where xs = unlines [header, body, footer]
header = "data PlatformConstants = PlatformConstants {"
footer = " } deriving Read"
header = "module GHC.Platform.Constants where\n\n\
\import Prelude\n\n\
\data PlatformConstants = PlatformConstants {"
footer = " } deriving (Show,Read,Eq)"
body = intercalate ",\n" (concatMap doWhat ws)
doWhat (GetClosureSize name _) = [" pc_" ++ name ++ " :: Int"]
......@@ -909,16 +911,17 @@ writeHaskellWrappers :: FilePath -> [What Fst] -> IO ()
writeHaskellWrappers fn ws = writeFile fn xs
where xs = unlines body
body = concatMap doWhat ws
constants = " (platformConstants (targetPlatform dflags))"
doWhat (GetFieldType {}) = []
doWhat (GetClosureSize {}) = []
doWhat (GetWord name _) = [haskellise name ++ " :: DynFlags -> Int",
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
haskellise name ++ " dflags = pc_" ++ name ++ constants]
doWhat (GetInt name _) = [haskellise name ++ " :: DynFlags -> Int",
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
haskellise name ++ " dflags = pc_" ++ name ++ constants]
doWhat (GetNatural name _) = [haskellise name ++ " :: DynFlags -> Integer",
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
haskellise name ++ " dflags = pc_" ++ name ++ constants]
doWhat (GetBool name _) = [haskellise name ++ " :: DynFlags -> Bool",
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
haskellise name ++ " dflags = pc_" ++ name ++ constants]
doWhat (StructFieldMacro {}) = []
doWhat (ClosureFieldMacro {}) = []
doWhat (ClosurePayloadMacro {}) = []
......
......@@ -643,6 +643,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
Right appdir -> do
-- See Note [Settings File] about this file, and why we need GHC to share it with us.
let settingsFile = top_dir </> "settings"
let constantsFile = top_dir </> "platformConstants"
exists_settings_file <- doesFileExist settingsFile
targetPlatformMini <- case exists_settings_file of
False -> do
......@@ -656,7 +657,11 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- It's excusable to not have a settings file (for now at
-- least) but completely inexcusable to have a malformed one.
Nothing -> die $ "Can't parse settings file " ++ show settingsFile
case getTargetPlatform settingsFile mySettings of
constantsStr <- readFile constantsFile
constants <- case maybeReadFuzzy constantsStr of
Just s -> pure s
Nothing -> die $ "Can't parse platform constants file " ++ show constantsFile
case getTargetPlatform settingsFile mySettings constants of
Right platform -> pure $ platformMini platform
Left e -> die e
let subdir = uniqueSubdir targetPlatformMini
......
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