1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
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
import Hadrian.Expression
import Settings.Builders.Common (cArgs)
-- | Build in-tree GMP library objects (if GmpInTree flag is set) and return
-- their paths.
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 ghcBignum
ghcBignumPath <- buildPath ctx
need [ghcBignumPath -/- "include/ghc-gmp.h"]
gmpPath <- gmpIntreePath s
map (unifyPath . (gmpPath -/-)) <$>
-- Note we don't track the object files of the in-tree GMP library (cf
-- #15971).
liftIO (getDirectoryFilesIO gmpPath [gmpObjectsDir -/- "*.o"])
-- | Build directory for in-tree GMP library
-- <root>/stageN/gmp/gmpbuild
gmpBuildPath :: Stage -> Action FilePath
gmpBuildPath s = gmpIntreePath s <&> (-/- "gmpbuild")
-- | Root directory for in-tree GMP library
-- <root>/stageN/gmp
gmpIntreePath :: Stage -> Action FilePath
gmpIntreePath s = buildRoot <&> (-/- stageString s -/- "gmp")
-- | Directory for in-tree GMP library object files, relative to 'gmpIntreePath'.
gmpObjectsDir :: FilePath
gmpObjectsDir = "objs"
gmpRules :: Rules ()
gmpRules = do
root <- buildRootRules
let
-- Path to libraries/integer-gmp/gmp in the source tree
gmpBase :: FilePath
gmpBase = pkgPath ghcBignum -/- "gmp"
-- Build in-tree gmp if necessary
-- Produce: ghc-bignum/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/ghc-bignum/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 isInTree
then do
putBuild "| In tree GMP will be built"
let intreeHeader = stageP -/- "gmp/gmp.h"
need [intreeHeader]
copyFile intreeHeader header
else do
putBuild "| System GMP library/framework will be used"
copyFile (gmpBase -/- "ghc-gmp.h") header
-- 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 ghc-bignum package.
makeGmpPathContext gmpP = do
let
stageP = takeDirectory gmpP
stageS = takeFileName stageP
stage <- parsePath parseStage "<stage>" stageS
pure (vanillaContext stage ghcBignum)
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 ctx (Ar Unpack (stage ctx))
[top -/- gmpP -/- "libgmp.a"] [gmpP -/- gmpObjectsDir]
objs <- liftIO $ getDirectoryFilesIO "." [gmpP -/- gmpObjectsDir -/- "*"]
produces objs
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
cFlags <- interpretInContext ctx $ mconcat [ cArgs, getStagedSettingList ConfCcArgs ]
env <- sequence
[ builderEnvironment "CC" $ Cc CompileC (stage ctx)
, return . AddEnv "CFLAGS" $ unwords cFlags
, builderEnvironment "AR" (Ar Unpack (stage ctx))
, builderEnvironment "NM" Nm
]
need [mk <.> "in"]
buildWithCmdOptions env $
target ctx (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 gmpBuildP = takeDirectory mkIn
gmpP = takeDirectory gmpBuildP
ctx <- makeGmpPathContext gmpP
removeDirectory gmpBuildP
-- 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 ctx (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) gmpBuildP
|
