Unverified Commit 23580909 authored by Andrey Mokhov's avatar Andrey Mokhov Committed by GitHub

Refactor package-specific settings (#622)

* Minor clean up

* Track rts.cabal

* Move all package-specific settings to Settings.Packages, plus another revision, see #540

* Drop Rules.PackageData
parent 0b35e12f
......@@ -22,7 +22,7 @@ executable hadrian
, Builder
, CommandLine
, Context
, Context.Paths
, Context.Path
, Context.Type
, Environment
, Expression
......@@ -55,7 +55,6 @@ executable hadrian
, Rules.Clean
, Rules.Compile
, Rules.Configure
, Rules.PackageData
, Rules.Dependencies
, Rules.Documentation
, Rules.Generate
......@@ -94,7 +93,6 @@ executable hadrian
, Settings.Flavours.QuickCross
, Settings.Flavours.Quickest
, Settings.Packages
, Settings.Packages.Rts
, Settings.Warnings
, Stage
, Target
......
......@@ -20,12 +20,11 @@ module Base (
-- * Files
configH, ghcVersionH,
-- * Paths
hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
generatedDir, generatedPath,
stageBinPath, stageLibPath,
templateHscPath, ghcDeps,
relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath
generatedDir, generatedPath, stageBinPath, stageLibPath, templateHscPath,
ghcDeps, relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath
) where
import Control.Applicative
......
......@@ -13,7 +13,7 @@ module Context (
) where
import Base
import Context.Paths
import Context.Path
import Context.Type
import Hadrian.Expression
import Hadrian.Haskell.Cabal
......@@ -78,6 +78,7 @@ pkgInplaceConfig context = do
path <- contextPath context
return $ path -/- "inplace-pkg-config"
-- TODO: Add a @Rules FilePath@ alternative.
-- | Path to the @setup-config@ of a given 'Context'.
pkgSetupConfigFile :: Context -> Action FilePath
pkgSetupConfigFile context = do
......
module Context.Paths where
module Context.Path where
import Base
import Context.Type
import Hadrian.Expression
-- | The directory to the current stage
-- | The build directory of the current 'Stage'.
stageDir :: Context -> FilePath
stageDir Context {..} = stageString stage
-- | The path to the current stage
-- | The build path of the current 'Stage'.
stagePath :: Context -> Action FilePath
stagePath context = buildRoot <&> (-/- stageDir context)
-- | The expression that evaluates to the build path of the current 'Stage'.
getStagePath :: Expr Context b FilePath
getStagePath = expr . stagePath =<< getContext
......@@ -19,10 +20,13 @@ getStagePath = expr . stagePath =<< getContext
contextDir :: Context -> FilePath
contextDir Context {..} = stageString stage -/- pkgPath package
-- | Path to the context directory, containing the "build folder"
-- | The path to the directory in 'buildRoot' containing build artifacts of a
-- given 'Context'.
contextPath :: Context -> Action FilePath
contextPath context = buildRoot <&> (-/- contextDir context)
-- | The expression that evaluates to the path to the directory in 'buildRoot'
-- containing build artifacts of a given 'Context'.
getContextPath :: Expr Context b FilePath
getContextPath = expr . contextPath =<< getContext
......@@ -34,6 +38,6 @@ buildDir context = contextDir context -/- "build"
buildPath :: Context -> Action FilePath
buildPath context = buildRoot <&> (-/- buildDir context)
-- | Get the build path of the current 'Context'.
-- | The expression that evaluates to the build path of the current 'Context'.
getBuildPath :: Expr Context b FilePath
getBuildPath = expr . buildPath =<< getContext
......@@ -15,7 +15,8 @@ module GHC (
programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
-- * Miscellaneous
programPath, buildDll0
programPath, buildDll0, rtsContext, rtsBuildPath, libffiContext,
libffiBuildPath, libffiLibraryName
) where
import Base
......@@ -174,3 +175,28 @@ buildDll0 :: Context -> Action Bool
buildDll0 Context {..} = do
windows <- windowsHost
return $ windows && stage == Stage1 && package == compiler
-- | RTS is considered a Stage1 package. This determines RTS build directory.
rtsContext :: Context
rtsContext = vanillaContext Stage1 rts
-- | Path to the RTS build directory.
rtsBuildPath :: Action FilePath
rtsBuildPath = buildPath rtsContext
-- | Libffi is considered a Stage1 package. This determines its build directory.
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi
-- | Build directory for in-tree Libffi library.
libffiBuildPath :: Action FilePath
libffiBuildPath = buildPath libffiContext
libffiLibraryName :: Action FilePath
libffiLibraryName = do
useSystemFfi <- flag UseSystemFfi
windows <- windowsHost
return $ case (useSystemFfi, windows) of
(True , False) -> "ffi"
(False, False) -> "Cffi"
(_ , True ) -> "Cffi-6"
......@@ -17,7 +17,6 @@ import qualified Rules.Generate
import qualified Rules.Gmp
import qualified Rules.Libffi
import qualified Rules.Library
import qualified Rules.PackageData
import qualified Rules.Program
import qualified Rules.Register
import Settings
......@@ -108,15 +107,15 @@ packageRules = do
Rules.Program.buildProgram readPackageDb
forM_ [Stage0 .. ] $ \stage -> do
forM_ [Stage0 .. ] $ \stage ->
-- we create a dummy context, that has the correct state, but contains
-- @dummyPackage@ as a... dummy package. The package isn't accessed but the record
-- need to be set properly. @undefined@ is not an option as it ends up
-- being forced.
Rules.Register.registerPackages writePackageDb (Context stage dummyPackage vanilla)
Rules.Register.registerPackage writePackageDb (Context stage dummyPackage vanilla)
forM_ vanillaContexts $ mconcat
[ Rules.PackageData.buildPackageData
[ Rules.Register.configurePackage
, Rules.Dependencies.buildPackageDependencies readPackageDb
, Rules.Documentation.buildPackageDocumentation
, Rules.Generate.generatePackageCode ]
......
......@@ -10,10 +10,15 @@ import GHC
import Target
import Utilities
-- TODO: Make this list complete.
-- | Files generated by running the @configure@ script.
configureResults :: [FilePath]
configureResults =
[ configFile, "settings", configH, "compiler/ghc.cabal", "rts/rts.cabal"]
configureRules :: Rules ()
configureRules = do
-- TODO: consider other files we should track here, e.g. @rts/rts.cabal@.
[configFile, "settings", configH, "compiler/ghc.cabal"] &%> \outs -> do
configureResults &%> \outs -> do
skip <- not <$> cmdConfigure
if skip
then unlessM (doesFileExist configFile) $
......
......@@ -6,14 +6,13 @@ module Rules.Generate (
import Base
import Expression
import Flavour
import GHC.Packages
import GHC
import Oracles.Flag
import Oracles.ModuleFiles
import Oracles.Setting
import Rules.Gmp
import Rules.Libffi
import Settings
import Settings.Packages.Rts
import Target
import Utilities
......
......@@ -82,7 +82,7 @@ gmpRules = do
root <//> "gmp/config.mk" %> \_ -> do
-- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@
-- Building anything in a package transitively depends on its configuration.
setupConfig <- contextPath gmpContext <&> (-/- "setup-config")
setupConfig <- pkgSetupConfigFile gmpContext
need [setupConfig]
-- TODO: Get rid of hard-coded @gmp@.
......
module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where
module Rules.Libffi (libffiRules, libffiDependencies) where
import GHC.Packages
import GHC
import Hadrian.Utilities
import Settings.Builders.Common
import Settings.Packages.Rts
import Target
import Utilities
-- | Libffi is considered a Stage1 package. This determines its build directory.
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi
-- | Build directory for in-tree Libffi library.
libffiBuildPath :: Action FilePath
libffiBuildPath = buildPath libffiContext
libffiDependencies :: [FilePath]
libffiDependencies = ["ffi.h", "ffitarget.h"]
libffiLibrary :: FilePath
libffiLibrary = "inst/lib/libffi.a"
rtsLibffiLibrary :: Way -> Action FilePath
rtsLibffiLibrary way = do
name <- libffiLibraryName
suf <- libsuf way
rtsPath <- rtsBuildPath
return $ rtsPath -/- "lib" ++ name ++ suf
fixLibffiMakefile :: FilePath -> String -> String
fixLibffiMakefile top =
replace "-MD" "-MMD"
. replace "@toolexeclibdir@" "$(libdir)"
. replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
-- TODO: remove code duplication (see Settings/Builders/GhcCabal.hs)
-- TODO: check code duplication w.r.t. ConfCcArgs
configureEnvironment :: Action [CmdOption]
configureEnvironment = do
......
module Rules.PackageData (buildPackageData) where
import Base
import Context
import Expression
import GHC.Packages
import Settings.Packages.Rts
import Target
import Utilities
import Hadrian.Haskell.Cabal.Parse (configurePackage)
-- | Build @setup-config@ and @inplace-pkg-config@ files
-- for packages. Look at the "Rules" module to see this
-- instantiated against all the packages.
buildPackageData :: Context -> Rules ()
buildPackageData context@Context {..} = do
root <- buildRootRules
let dir = root -/- contextDir context
dir -/- "setup-config" %> \_ -> configurePackage context
dir -/- "inplace-pkg-config" %> \conf -> do
when (package == rts) $ do
genPath <- buildRoot <&> (-/- generatedDir)
rtsPath <- rtsBuildPath
need [rtsConfIn]
build $ target context HsCpp [rtsConfIn] [conf]
fixFile conf $ unlines
. map
( replace "\"\"" ""
. replace "rts/dist/build" rtsPath
. replace "includes/dist-derivedconstants/header" genPath )
. lines
......@@ -10,7 +10,6 @@ import GHC
import Oracles.Flag
import Oracles.ModuleFiles
import Settings
import Settings.Packages.Rts
import Target
import Utilities
......
module Rules.Register (registerPackages) where
module Rules.Register (configurePackage, registerPackage) where
import Distribution.ParseUtils
import Distribution.Version (Version)
import Base
import Context
......@@ -7,29 +10,36 @@ import Settings
import Target
import Utilities
import Distribution.ParseUtils
import Hadrian.Expression
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Version (Version)
import qualified System.Directory as IO
import Hadrian.Expression
import Hadrian.Haskell.Cabal.Parse as Cabal
import qualified Hadrian.Haskell.Cabal.Parse as Cabal
parseCabalName :: String -> Maybe (String, Version)
parseCabalName = readPToMaybe parse
where parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion
where
parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion
-- | Build rules for registering packages and initialising package databases
-- by running the @ghc-pkg@ utility.
registerPackages :: [(Resource, Int)] -> Context -> Rules ()
registerPackages rs context@Context {..} = do
-- | Configure a package and build its @setup-config@ file.
configurePackage :: Context -> Rules ()
configurePackage context@Context {..} = do
root <- buildRootRules
root -/- relativePackageDbPath stage %> buildStamp rs context
root -/- contextDir context -/- "setup-config" %> \_ ->
Cabal.configurePackage context
-- | Registering a package and initialise the corresponding package database if
-- need be.
registerPackage :: [(Resource, Int)] -> Context -> Rules ()
registerPackage rs context@Context {..} = do
root <- buildRootRules
-- Initialise the package database.
root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
writeFileLines stamp []
-- TODO: Add proper error handling for partial functions.
-- Register a package.
root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
settings <- libPath context <&> (-/- "settings")
platformConstants <- libPath context <&> (-/- "platformConstants")
......@@ -46,9 +56,8 @@ buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildConf _ context@Context {..} _conf = do
depPkgIds <- cabalDependencies context
-- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@
-- Building anything in a package transitively depends on its configuration.
setupConfig <- contextPath context <&> (-/- "setup-config")
-- Calling 'need' on @setupConfig@, triggers the package configuration.
setupConfig <- pkgSetupConfigFile context
need [setupConfig]
need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
......@@ -71,8 +80,8 @@ buildConf _ context@Context {..} _conf = do
when (package == integerGmp) $ need [path -/- "ghc-gmp.h"]
-- Copy and register the package.
copyPackage context
registerPackage context
Cabal.copyPackage context
Cabal.registerPackage context
copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
copyConf rs context@Context {..} conf = do
......@@ -94,9 +103,3 @@ copyConf rs context@Context {..} conf = do
where
stdOutToPkgIds :: String -> [String]
stdOutToPkgIds = drop 1 . concatMap words . lines
buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildStamp rs Context {..} path = do
buildWithResources rs $
target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
putSuccess $ "| Successfully initialised " ++ path
module Settings.Builders.Configure (configureBuilderArgs) where
import GHC
import Rules.Gmp
import Rules.Libffi
import Settings.Builders.Common
configureBuilderArgs :: Args
......
......@@ -3,7 +3,6 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where
import GHC
import Oracles.Setting
import Rules.Gmp
import Rules.Libffi
import Settings.Builders.Common
makeBuilderArgs :: Args
......
......@@ -26,7 +26,6 @@ import Settings.Builders.Make
import Settings.Builders.RunTest
import Settings.Builders.Xelatex
import Settings.Packages
import Settings.Packages.Rts
import Settings.Warnings
import {-# SOURCE #-} Builder
......@@ -152,7 +151,4 @@ defaultBuilderArgs = mconcat
-- | All 'Package'-dependent command line arguments.
defaultPackageArgs :: Args
defaultPackageArgs = mconcat
[ packageArgs
, rtsPackageArgs
, warningArgs ]
defaultPackageArgs = mconcat [ packageArgs, warningArgs ]
......@@ -2,19 +2,19 @@ module Settings.Packages (packageArgs) where
import Expression
import Flavour
import GHC.Packages
import GHC
import Oracles.Setting
import Oracles.Flag
import Rules.Gmp
import Settings
-- TODO: Finish migration of package-specific settings into a single file.
-- | Package-specific command-line arguments.
packageArgs :: Args
packageArgs = do
intLib <- getIntegerPackage
stage <- getStage
rtsWays <- getRtsWays
path <- getBuildPath
rtsWays <- getRtsWays
compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler)
gmpBuildPath <- expr gmpBuildPath
......@@ -139,6 +139,14 @@ packageArgs = do
arg ("--configure-option=CFLAGS=" ++ includeGmp)
, arg ("--gcc-options=" ++ includeGmp) ] ]
---------------------------------- rts ---------------------------------
, package rts ? rtsPackageArgs -- RTS deserves a separate function
-------------------------------- runGhc --------------------------------
, package runGhc ?
builder Ghc ? input "//Main.hs" ?
(\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion
--------------------------------- text ---------------------------------
-- The package @text@ is rather tricky. It's a boot library, and it
-- tries to determine on its own if it should link against @integer-gmp@
......@@ -150,13 +158,205 @@ packageArgs = do
-- in Stage1, and at that point the configuration is just wrong.
, package text ?
builder CabalFlags ? notStage0 ? intLib == integerSimple ?
pure [ "+integer-simple", "-bytestring-builder"]
pure [ "+integer-simple", "-bytestring-builder"] ]
-------------------------------- runGhc --------------------------------
, package runGhc ?
builder Ghc ? input "//Main.hs" ?
(\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion
-- | RTS-specific command line arguments.
rtsPackageArgs :: Args
rtsPackageArgs = package rts ? do
projectVersion <- getSetting ProjectVersion
hostPlatform <- getSetting HostPlatform
hostArch <- getSetting HostArch
hostOs <- getSetting HostOs
hostVendor <- getSetting HostVendor
buildPlatform <- getSetting BuildPlatform
buildArch <- getSetting BuildArch
buildOs <- getSetting BuildOs
buildVendor <- getSetting BuildVendor
targetPlatform <- getSetting TargetPlatform
targetArch <- getSetting TargetArch
targetOs <- getSetting TargetOs
targetVendor <- getSetting TargetVendor
ghcUnreg <- expr $ yesNo <$> flag GhcUnregisterised
ghcEnableTNC <- expr $ yesNo <$> ghcEnableTablesNextToCode
rtsWays <- getRtsWays
way <- getWay
path <- getBuildPath
top <- expr topDirectory
libffiName <- expr libffiLibraryName
ffiIncludeDir <- getSetting FfiIncludeDir
ffiLibraryDir <- getSetting FfiLibDir
ghclibDir <- expr installGhcLibDir
destDir <- expr getDestDir
let cArgs = mconcat
[ arg "-Irts"
, rtsWarnings
, arg $ "-I" ++ path
, flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir)
, arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
-- Set the namespace for the rts fs functions
, arg $ "-DFS_NAMESPACE=rts"
, arg $ "-DCOMPILING_RTS"
-- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
-- requires that functions are inlined to work as expected. Inlining
-- only happens for optimised builds. Otherwise we can assume that
-- there is a non-inlined variant to use instead. But RTS does not
-- provide non-inlined alternatives and hence needs the function to
-- be inlined. See https://github.com/snowleopard/hadrian/issues/90.
, arg "-O2"
, arg "-fomit-frame-pointer"
, arg "-g"
---------------------------------- rts ---------------------------------
, package rts ?
builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling" ]
, Debug `wayUnit` way ? pure [ "-DDEBUG"
, "-fno-omit-frame-pointer"
, "-g"
, "-O0" ]
, way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY"
, Profiling `wayUnit` way ? arg "-DPROFILING"
, Threaded `wayUnit` way ? arg "-DTHREADED_RTS"
, inputs ["//RtsMessages.c", "//Trace.c"] ?
arg ("-DProjectVersion=" ++ show projectVersion)
, input "//RtsUtils.c" ? pure
[ "-DProjectVersion=" ++ show projectVersion
, "-DHostPlatform=" ++ show hostPlatform
, "-DHostArch=" ++ show hostArch
, "-DHostOS=" ++ show hostOs
, "-DHostVendor=" ++ show hostVendor
, "-DBuildPlatform=" ++ show buildPlatform
, "-DBuildArch=" ++ show buildArch
, "-DBuildOS=" ++ show buildOs
, "-DBuildVendor=" ++ show buildVendor
, "-DTargetPlatform=" ++ show targetPlatform
, "-DTargetArch=" ++ show targetArch
, "-DTargetOS=" ++ show targetOs
, "-DTargetVendor=" ++ show targetVendor
, "-DGhcUnregisterised=" ++ show ghcUnreg
, "-DGhcEnableTablesNextToCode=" ++ show ghcEnableTNC ]
-- We're after pur performance here. So make sure fast math and
-- vectorization is enabled.
, input "//xxhash.c" ? pure
[ "-O3"
, "-ffast-math"
, "-ftree-vectorize" ]
, inputs ["//Evac.c", "//Evac_thr.c"] ? arg "-funroll-loops"
, speedHack ?
inputs [ "//Evac.c", "//Evac_thr.c"
, "//Scav.c", "//Scav_thr.c"
, "//Compact.c", "//GC.c" ] ? arg "-fno-PIC"
-- @-static@ is necessary for these bits, as otherwise the NCG
-- generates dynamic references.
, speedHack ?
inputs [ "//Updates.c", "//StgMiscClosures.c"
, "//PrimOps.c", "//Apply.c"
, "//AutoApply.c" ] ? pure ["-fno-PIC", "-static"]
-- inlining warnings happen in Compact
, inputs ["//Compact.c"] ? arg "-Wno-inline"
-- emits warnings about call-clobbered registers on x86_64
, inputs [ "//RetainerProfile.c", "//StgCRun.c"
, "//win32/ConsoleHandler.c", "//win32/ThrIOManager.c"] ? arg "-w"
-- The above warning suppression flags are a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See:
-- http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
, (not <$> flag GccIsClang) ?
inputs ["//Compact.c"] ? arg "-finline-limit=2500"
, input "//RetainerProfile.c" ? flag GccIsClang ?
arg "-Wno-incompatible-pointer-types"
, windowsHost ? arg ("-DWINVER=" ++ windowsVersion)
-- libffi's ffi.h triggers various warnings
, inputs [ "//Interpreter.c", "//Storage.c", "//Adjustor.c" ] ?
arg "-Wno-strict-prototypes"
, inputs ["//Interpreter.c", "//Adjustor.c", "//sm/Storage.c"] ?
anyTargetArch ["powerpc"] ? arg "-Wno-undef" ]
mconcat
[ builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling"
, builder (Cc FindCDependencies) ? cArgs
, builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
, builder Ghc ? arg "-Irts"
, builder HsCpp ? pure
[ "-DTOP=" ++ show top
, "-DFFI_INCLUDE_DIR=" ++ show ffiIncludeDir
, "-DFFI_LIB_DIR=" ++ show ffiLibraryDir
, "-DFFI_LIB=" ++ show libffiName ]
, builder HsCpp ?
input "//package.conf.in" ?
output "//package.conf.install.raw" ?
pure [ "-DINSTALLING"
, "-DLIB_DIR=\"" ++ destDir ++ ghclibDir ++ "\""
, "-DINCLUDE_DIR=\"" ++ destDir ++ ghclibDir -/- "include\"" ]
, builder HsCpp ? flag HaveLibMingwEx ? arg "-DHAVE_LIBMINGWEX" ]
-- Compile various performance-critical pieces *without* -fPIC -dynamic
-- even when building a shared library. If we don't do this, then the
-- GC runs about 50% slower on x86 due to the overheads of PIC. The
-- cost of doing this is a little runtime linking and less sharing, but
-- not much.
--
-- On x86_64 this doesn't work, because all objects in a shared library
-- must be compiled with -fPIC (since the 32-bit relocations generated
-- by the default small memory can't be resolved at runtime). So we
-- only do this on i386.
--
-- This apparently doesn't work on OS X (Darwin) nor on Solaris.
-- On Darwin we get errors of the form
--
-- ld: absolute addressing (perhaps -mdynamic-no-pic) used in _stg_ap_0_fast
-- from rts/dist/build/Apply.dyn_o not allowed in slidable image
--
-- and lots of these warnings:
--
-- ld: warning codegen in _stg_ap_pppv_fast (offset 0x0000005E) prevents image
-- from loading in dyld shared cache
--
-- On Solaris we get errors like:
--
-- Text relocation remains referenced
-- against symbol offset in file
-- .rodata (section) 0x11 rts/dist/build/Apply.dyn_o
-- ...
-- ld: fatal: relocations remain against allocatable but non-writable sections