Commit d7029cc0 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Hadrian: refactor GMP in-tree build support (#17756)

* Hadrian doesn't use integer-gmp/config.mk file anymore to determine if
  building GMP in-tree is required.

  "config.mk" is created by Cabal when the integer-gmp package is
  configured and this file is still untracked by Hadrian. This led to a
  tricky configure "race" because "config.mk" is built by the
  "setup-config" rule, but this rule is also used to find dependencies,
  in particular the "ghc-gmp.h" header, but the creation of this file
  was depending (without being tracked) on "config.mk".

  Now Hadrian only builds in-tree GMP if `--with-intree-gmp` is passed
  to the top-level configure script.

* in-tree GMP isn't built once for all in a fixed stage (Stage1)
  anymore. It is built per stage which is required if we build a
  cross-compiler

* switching between in-tree and external GMP is now supported without
  having to clean the build directory first.

* "wrappers.c" now includes "ghc-gmp.h" instead of "ghc.h". It
  helps ensuring that the build system generates "ghc-gmp.h".

* build in-tree GMP in "<root>/stageN/gmp/gmpbuild" and produce useful
  artefacts (libgmp.a, gmp.h, objs/*.o) in "<root>/stageN/gmp"
parent b4a8ce52
...@@ -15,7 +15,6 @@ import Oracles.Flag ...@@ -15,7 +15,6 @@ import Oracles.Flag
import Oracles.ModuleFiles import Oracles.ModuleFiles
import Oracles.Setting import Oracles.Setting
import Packages import Packages
import Rules.Gmp
import Rules.Libffi import Rules.Libffi
import Settings import Settings
import Settings.Builders.DeriveConstants (deriveConstantsPairs) import Settings.Builders.DeriveConstants (deriveConstantsPairs)
...@@ -53,11 +52,11 @@ compilerDependencies = do ...@@ -53,11 +52,11 @@ compilerDependencies = do
stage <- getStage stage <- getStage
isGmp <- (== integerGmp) <$> getIntegerPackage isGmp <- (== integerGmp) <$> getIntegerPackage
ghcPath <- expr $ buildPath (vanillaContext stage compiler) ghcPath <- expr $ buildPath (vanillaContext stage compiler)
gmpPath <- expr gmpBuildPath gmpPath <- expr $ buildPath (vanillaContext stage integerGmp)
rtsPath <- expr (rtsBuildPath stage) rtsPath <- expr (rtsBuildPath stage)
libDir <- expr $ stageLibPath stage libDir <- expr $ stageLibPath stage
mconcat [ return $ (libDir -/-) <$> derivedConstantsFiles mconcat [ return $ (libDir -/-) <$> derivedConstantsFiles
, notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH] , notStage0 ? isGmp ? return [gmpPath -/- "include/ghc-gmp.h"]
, notStage0 ? return ((rtsPath -/-) <$> libffiHeaderFiles) , notStage0 ? return ((rtsPath -/-) <$> libffiHeaderFiles)
, return $ fmap (ghcPath -/-) , return $ fmap (ghcPath -/-)
[ "primop-can-fail.hs-incl" [ "primop-can-fail.hs-incl"
......
module Rules.Gmp (gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH) where module Rules.Gmp (gmpRules, gmpBuildPath, gmpObjects) where
import Base import Base
import Context import Context
import Oracles.Setting import Oracles.Setting
import Oracles.Flag
import Packages import Packages
import Target import Target
import Utilities import Utilities
import Hadrian.BuildPath
-- | Build GMP library objects and return their paths. -- | Build GMP library objects and return their paths.
gmpObjects :: Action [FilePath] gmpObjects :: Stage -> Action [FilePath]
gmpObjects = do gmpObjects s = do
gmpPath <- gmpBuildPath isInTree <- flag GmpInTree
need [gmpPath -/- gmpLibraryH] if not isInTree
-- The line below causes a Shake Lint failure on Windows, which forced us to then return []
-- disable Lint by default. See more details here: else do
-- https://gitlab.haskell.org/ghc/ghc/issues/15971. -- Indirectly ensure object creation
map (unifyPath . (gmpPath -/-)) <$> let ctx = vanillaContext s integerGmp
liftIO (getDirectoryFilesIO gmpPath [gmpObjectsDir -/- "*.o"]) integerGmpPath <- buildPath ctx
need [integerGmpPath -/- "include/ghc-gmp.h"]
-- The line below causes a Shake Lint failure on Windows, which forced
-- us to disable Lint by default. See more details here:
-- https://gitlab.haskell.org/ghc/ghc/issues/15971.
gmpPath <- gmpIntreePath s
map (unifyPath . (gmpPath -/-)) <$>
liftIO (getDirectoryFilesIO gmpPath [gmpObjectsDir -/- "*.o"])
gmpBase :: FilePath gmpBase :: FilePath
gmpBase = pkgPath integerGmp -/- "gmp" gmpBase = pkgPath integerGmp -/- "gmp"
gmpLibraryInTreeH :: FilePath
gmpLibraryInTreeH = "include/gmp.h"
gmpLibrary :: FilePath
gmpLibrary = ".libs/libgmp.a"
-- | GMP is considered a Stage1 package. This determines GMP build directory. -- | GMP is considered a Stage1 package. This determines GMP build directory.
gmpContext :: Context gmpContext :: Context
gmpContext = vanillaContext Stage1 integerGmp gmpContext = vanillaContext Stage1 integerGmp
-- TODO: Location of 'gmpBuildPath' is important: it should be outside any
-- package build directory, as otherwise GMP's object files will match build
-- patterns of 'compilePackage' rules. We could make 'compilePackage' rules
-- more precise to avoid such spurious matching.
-- | Build directory for in-tree GMP library. -- | Build directory for in-tree GMP library.
gmpBuildPath :: Action FilePath gmpBuildPath :: Stage -> Action FilePath
gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp") gmpBuildPath s = gmpIntreePath s <&> (-/- "gmpbuild")
-- | Like 'gmpBuildPath' but in the 'Rules' monad.
gmpBuildPathRules :: Rules FilePath
gmpBuildPathRules = buildRootRules <&> (-/- stageString (stage gmpContext) -/- "gmp")
-- | GMP library header, relative to 'gmpBuildPath'. gmpIntreePath :: Stage -> Action FilePath
gmpLibraryH :: FilePath gmpIntreePath s = buildRoot <&> (-/- stageString s -/- "gmp")
gmpLibraryH = "include/ghc-gmp.h"
-- | Directory for GMP library object files, relative to 'gmpBuildPath'. -- | Directory for GMP library object files, relative to 'gmpIntreePath'.
gmpObjectsDir :: FilePath gmpObjectsDir :: FilePath
gmpObjectsDir = "objs" gmpObjectsDir = "objs"
configureEnvironment :: Action [CmdOption] configureEnvironment :: Stage -> Action [CmdOption]
configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1 configureEnvironment s = sequence [ builderEnvironment "CC" $ Cc CompileC s
, builderEnvironment "AR" (Ar Unpack Stage1) , builderEnvironment "AR" (Ar Unpack s)
, builderEnvironment "NM" Nm ] , builderEnvironment "NM" Nm ]
gmpRules :: Rules () gmpRules :: Rules ()
gmpRules = do gmpRules = do
-- Copy appropriate GMP header and object files root <- buildRootRules
gmpPath <- gmpBuildPathRules
gmpPath -/- gmpLibraryH %> \header -> do -- Build in-tree gmp if necessary
configMk <- readFile' =<< (buildPath gmpContext <&> (-/- "config.mk")) -- Produce: integer-gmp/build/include/ghc-gmp.h
if not windowsHost && -- TODO: We don't use system GMP on Windows. Fix? -- In-tree: copy gmp.h from in-tree build
any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ] -- External: copy ghc-gmp.h from base sources
root -/- "stage*/libraries/integer-gmp/build/include/ghc-gmp.h" %> \header -> do
let includeP = takeDirectory header
buildP = takeDirectory includeP
packageP = takeDirectory buildP
librariesP = takeDirectory packageP
stageP = takeDirectory librariesP
isInTree <- flag GmpInTree
if windowsHost || isInTree -- TODO: We don't use system GMP on Windows. Fix?
then do then do
putBuild "| No GMP library/framework detected; in tree GMP will be built"
let intreeHeader = stageP -/- "gmp/gmp.h"
need [intreeHeader]
copyFile intreeHeader header
else do
putBuild "| GMP library/framework detected and will be used" putBuild "| GMP library/framework detected and will be used"
copyFile (gmpBase -/- "ghc-gmp.h") header copyFile (gmpBase -/- "ghc-gmp.h") header
else do
putBuild "| No GMP library/framework detected; in tree GMP will be built" -- Build in-tree GMP library for the current stage, prioritised so that it
need [gmpPath -/- gmpLibrary] -- matches "before" the generic @.a@ library rule in 'Rules.Library'.
createDirectory (gmpPath -/- gmpObjectsDir) priority 2.0 $ do
let
-- parse a path of the form "//stage*/gmp/xxx" and returns a vanilla
-- context from it for integer-gmp package.
makeGmpPathContext gmpP = do
let
stageP = takeDirectory gmpP
stageS = takeFileName stageP
stage <- parsePath parseStage "<stage>" stageS
pure (vanillaContext stage integerGmp)
gmpPath = root -/- "stage*/gmp"
-- Build in-tree gmp. Produce:
-- - <root>/stageN/gmp/gmp.h
-- - <root>/stageN/gmp/libgmp.a
-- - <root>/stageN/gmp/objs/*.o (unpacked objects from libgmp.a)
[gmpPath -/- "libgmp.a", gmpPath -/- "gmp.h"] &%> \[lib,header] -> do
let gmpP = takeDirectory lib
ctx <- makeGmpPathContext gmpP
-- build libgmp.a via gmp's Makefile
build $ target ctx (Make (gmpP -/- "gmpbuild")) [gmpP -/- "gmpbuild/Makefile"] []
-- copy header and lib to their final destination
copyFileUntracked (gmpP -/- "gmpbuild/.libs/libgmp.a") lib
copyFileUntracked (gmpP -/- "gmpbuild/gmp.h") header
-- we also unpack objects from libgmp.a into "objs" directory
createDirectory (gmpP -/- gmpObjectsDir)
top <- topDirectory top <- topDirectory
build $ target gmpContext (Ar Unpack Stage1) build $ target ctx (Ar Unpack (stage ctx))
[top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir] [top -/- gmpP -/- "libgmp.a"] [gmpP -/- gmpObjectsDir]
objs <- liftIO $ getDirectoryFilesIO "." [gmpPath -/- gmpObjectsDir -/- "*"] objs <- liftIO $ getDirectoryFilesIO "." [gmpP -/- gmpObjectsDir -/- "*"]
produces objs produces objs
copyFileUntracked (gmpPath -/- "gmp.h") header putSuccess "| Successfully built custom library 'gmp'"
-- Build in-tree GMP library, prioritised so that it matches "before" -- Run GMP's configure script. Produce:
-- the generic @.a@ library rule in 'Rules.Library'. -- - <root>/stageN/gmp/gmpbuild/Makefile
priority 2.0 $ gmpPath -/- gmpLibrary %> \lib -> do gmpPath -/- "gmpbuild/Makefile" %> \mk -> do
build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib] let gmpBuildP = takeDirectory mk
putSuccess "| Successfully built custom library 'gmp'" gmpP = takeDirectory gmpBuildP
ctx <- makeGmpPathContext gmpP
gmpPath -/- gmpLibraryInTreeH %> copyFile (gmpPath -/- gmpLibraryH) env <- configureEnvironment (stage ctx)
need [mk <.> "in"]
root <- buildRootRules buildWithCmdOptions env $
root -/- buildDir gmpContext -/- gmpLibraryH %> target gmpContext (Configure gmpBuildP) [mk <.> "in"] [mk]
copyFile (gmpPath -/- gmpLibraryH)
-- Extract in-tree GMP sources and apply patches. Produce
-- This file is created when 'integerGmp' is configured. -- - <root>/stageN/gmp/gmpbuild/Makefile.in
gmpPath -/- "config.mk" %> \_ -> ensureConfigured gmpContext -- - <root>/stageN/gmp/gmpbuild/configure
[gmpPath -/- "gmpbuild/Makefile.in", gmpPath -/- "gmpbuild/configure"] &%> \[mkIn,_] -> do
-- Run GMP's configure script top <- topDirectory
gmpPath -/- "Makefile" %> \mk -> do let destPath = takeDirectory mkIn
env <- configureEnvironment removeDirectory destPath
need [mk <.> "in"] -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
buildWithCmdOptions env $ -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
target gmpContext (Configure gmpPath) [mk <.> "in"] [mk] -- That's because the doc/ directory contents are under the GFDL,
-- which causes problems for Debian.
-- Extract in-tree GMP sources and apply patches tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
fmap (gmpPath -/-) ["Makefile.in", "configure"] &%> \_ -> do <$> getDirectoryFiles top [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
top <- topDirectory
removeDirectory gmpPath withTempDir $ \dir -> do
-- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is let tmp = unifyPath dir
-- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents. need [top -/- tarball]
-- That's because the doc/ directory contents are under the GFDL, build $ target gmpContext (Tar Extract) [top -/- tarball] [tmp]
-- which causes problems for Debian.
tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected" let patch = gmpBase -/- "gmpsrc.patch"
<$> getDirectoryFiles top [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"] patchName = takeFileName patch
copyFile patch $ tmp -/- patchName
withTempDir $ \dir -> do applyPatch tmp patchName
let tmp = unifyPath dir
need [top -/- tarball] let name = dropExtension . dropExtension $ takeFileName tarball
build $ target gmpContext (Tar Extract) [top -/- tarball] [tmp] unpack = fromMaybe . error $ "gmpRules: expected suffix "
++ "-nodoc (found: " ++ name ++ ")."
let patch = gmpBase -/- "gmpsrc.patch" libName = unpack $ stripSuffix "-nodoc" name
patchName = takeFileName patch
copyFile patch $ tmp -/- patchName moveDirectory (tmp -/- libName) destPath
applyPatch tmp patchName
let name = dropExtension . dropExtension $ takeFileName tarball
unpack = fromMaybe . error $ "gmpRules: expected suffix "
++ "-nodoc (found: " ++ name ++ ")."
libName = unpack $ stripSuffix "-nodoc" name
moveDirectory (tmp -/- libName) gmpPath
...@@ -7,7 +7,7 @@ import qualified Text.Parsec as Parsec ...@@ -7,7 +7,7 @@ import qualified Text.Parsec as Parsec
import Base import Base
import Context import Context
import Expression hiding (way, package) import Expression hiding (way, package, stage)
import Oracles.ModuleFiles import Oracles.ModuleFiles
import Packages import Packages
import Rules.Gmp import Rules.Gmp
...@@ -134,7 +134,7 @@ cObjects context = do ...@@ -134,7 +134,7 @@ cObjects context = do
-- 'Context' is @integer-gmp@. -- 'Context' is @integer-gmp@.
extraObjects :: Context -> Action [FilePath] extraObjects :: Context -> Action [FilePath]
extraObjects context extraObjects context
| package context == integerGmp = gmpObjects | package context == integerGmp = gmpObjects (stage context)
| otherwise = return [] | otherwise = return []
-- | Return all the object files to be put into the library we're building for -- | Return all the object files to be put into the library we're building for
......
...@@ -11,7 +11,6 @@ import Hadrian.Expression ...@@ -11,7 +11,6 @@ import Hadrian.Expression
import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal
import Oracles.Setting import Oracles.Setting
import Packages import Packages
import Rules.Gmp
import Rules.Rts import Rules.Rts
import {-# SOURCE #-} Rules.Library (needLibrary) import {-# SOURCE #-} Rules.Library (needLibrary)
import Settings import Settings
...@@ -40,6 +39,9 @@ configurePackageRules = do ...@@ -40,6 +39,9 @@ configurePackageRules = do
(stage, path) <- parsePath (parseSetupConfig root) "<setup config path parser>" out (stage, path) <- parsePath (parseSetupConfig root) "<setup config path parser>" out
let pkg = unsafeFindPackageByPath path let pkg = unsafeFindPackageByPath path
let ctx = Context stage pkg vanilla let ctx = Context stage pkg vanilla
buildP <- buildPath ctx
when (pkg == integerGmp) $
need [buildP -/- "include/ghc-gmp.h"]
needLibrary =<< contextDependencies ctx needLibrary =<< contextDependencies ctx
Cabal.configurePackage ctx Cabal.configurePackage ctx
...@@ -127,7 +129,9 @@ buildConf _ context@Context {..} conf = do ...@@ -127,7 +129,9 @@ buildConf _ context@Context {..} conf = do
, path -/- "ghcplatform.h" , path -/- "ghcplatform.h"
, path -/- "ghcversion.h" ] , path -/- "ghcversion.h" ]
when (package == integerGmp) $ need [path -/- gmpLibraryH] -- we need to generate this file for GMP
when (package == integerGmp) $
need [path -/- "include/ghc-gmp.h"]
-- Copy and register the package. -- Copy and register the package.
Cabal.copyPackage context Cabal.copyPackage context
......
...@@ -6,8 +6,8 @@ import Settings.Builders.Common ...@@ -6,8 +6,8 @@ import Settings.Builders.Common
configureBuilderArgs :: Args configureBuilderArgs :: Args
configureBuilderArgs = do configureBuilderArgs = do
gmpPath <- expr gmpBuildPath
stage <- getStage stage <- getStage
gmpPath <- expr (gmpBuildPath stage)
libffiPath <- expr (libffiBuildPath stage) libffiPath <- expr (libffiBuildPath stage)
mconcat [ builder (Configure gmpPath) ? do mconcat [ builder (Configure gmpPath) ? do
targetPlatform <- getSetting TargetPlatform targetPlatform <- getSetting TargetPlatform
......
...@@ -10,7 +10,8 @@ import CommandLine ...@@ -10,7 +10,8 @@ import CommandLine
makeBuilderArgs :: Args makeBuilderArgs :: Args
makeBuilderArgs = do makeBuilderArgs = do
threads <- shakeThreads <$> expr getShakeOptions threads <- shakeThreads <$> expr getShakeOptions
gmpPath <- expr gmpBuildPath stage <- getStage
gmpPath <- expr (gmpBuildPath stage)
libffiPaths <- forM [Stage1 ..] $ \s -> expr (libffiBuildPath s) libffiPaths <- forM [Stage1 ..] $ \s -> expr (libffiBuildPath s)
let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads
mconcat $ mconcat $
......
...@@ -5,7 +5,6 @@ import Flavour ...@@ -5,7 +5,6 @@ import Flavour
import Oracles.Setting import Oracles.Setting
import Oracles.Flag import Oracles.Flag
import Packages import Packages
import Rules.Gmp
import Settings import Settings
-- | Package-specific command-line arguments. -- | Package-specific command-line arguments.
...@@ -16,9 +15,7 @@ packageArgs = do ...@@ -16,9 +15,7 @@ packageArgs = do
path <- getBuildPath path <- getBuildPath
intLib <- getIntegerPackage intLib <- getIntegerPackage
compilerPath <- expr $ buildPath (vanillaContext stage compiler) compilerPath <- expr $ buildPath (vanillaContext stage compiler)
gmpBuildPath <- expr gmpBuildPath let -- Do not bind the result to a Boolean: this forces the configure rule
let includeGmp = "-I" ++ gmpBuildPath -/- "include"
-- Do not bind the result to a Boolean: this forces the configure rule
-- immediately and may lead to cyclic dependencies. -- immediately and may lead to cyclic dependencies.
-- See: https://gitlab.haskell.org/ghc/ghc/issues/16809. -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809.
cross = flag CrossCompiling cross = flag CrossCompiling
...@@ -150,17 +147,15 @@ packageArgs = do ...@@ -150,17 +147,15 @@ packageArgs = do
------------------------------ integerGmp ------------------------------ ------------------------------ integerGmp ------------------------------
, package integerGmp ? mconcat , package integerGmp ? mconcat
[ builder Cc ? arg includeGmp [ builder (Cabal Setup) ? mconcat
, builder (Cabal Setup) ? mconcat
[ flag GmpInTree ? arg "--configure-option=--with-intree-gmp" [ flag GmpInTree ? arg "--configure-option=--with-intree-gmp"
-- Windows is always built with inplace GMP until we have dynamic -- Windows is always built with inplace GMP until we have dynamic
-- linking working. -- linking working.
, windowsHost ? arg "--configure-option=--with-intree-gmp" , windowsHost ? arg "--configure-option=--with-intree-gmp"
, flag GmpFrameworkPref ? , flag GmpFrameworkPref ?
arg "--configure-option=--with-gmp-framework-preferred" arg "--configure-option=--with-gmp-framework-preferred"
, arg ("--configure-option=CFLAGS=" ++ includeGmp) ]
, arg ("--gcc-options=" ++ includeGmp) ] ] ]
---------------------------------- rts --------------------------------- ---------------------------------- rts ---------------------------------
, package rts ? rtsPackageArgs -- RTS deserves a separate function , package rts ? rtsPackageArgs -- RTS deserves a separate function
......
...@@ -12,6 +12,7 @@ ...@@ -12,6 +12,7 @@
#include "HsFFI.h" #include "HsFFI.h"
#include "MachDeps.h" #include "MachDeps.h"
#include "HsIntegerGmp.h" #include "HsIntegerGmp.h"
#include "ghc-gmp.h"
#include <assert.h> #include <assert.h>
#include <stdbool.h> #include <stdbool.h>
...@@ -22,7 +23,6 @@ ...@@ -22,7 +23,6 @@
#include <float.h> #include <float.h>
#include <stdio.h> #include <stdio.h>
#include <gmp.h>
// GMP 4.x compatibility // GMP 4.x compatibility
......
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