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