| ... |
... |
@@ -3,236 +3,50 @@ module Settings.Packages (packageArgs) where |
|
3
|
3
|
import Data.Version.Extra
|
|
4
|
4
|
import Expression
|
|
5
|
5
|
import Flavour
|
|
6
|
|
-import GHC.Platform.ArchOS
|
|
7
|
|
-import qualified GHC.Toolchain.Library as Lib
|
|
8
|
|
-import GHC.Toolchain.Target
|
|
|
6
|
+import Oracles.Setting hiding (ghcWithInterpreter)
|
|
9
|
7
|
import Oracles.Flag
|
|
10
|
|
-import Oracles.Setting
|
|
11
|
8
|
import Packages
|
|
12
|
9
|
import Settings
|
|
13
|
10
|
import Settings.Builders.Common (wayCcArgs)
|
|
14
|
11
|
|
|
|
12
|
+import qualified GHC.Toolchain.Library as Lib
|
|
|
13
|
+import GHC.Toolchain.Target
|
|
|
14
|
+import GHC.Platform.ArchOS
|
|
|
15
|
+import Settings.Program (ghcWithInterpreter)
|
|
|
16
|
+
|
|
15
|
17
|
-- | Package-specific command-line arguments.
|
|
16
|
18
|
packageArgs :: Args
|
|
17
|
19
|
packageArgs = do
|
|
18
|
|
- stage <- getStage
|
|
19
|
|
- path <- getBuildPath
|
|
20
|
|
- compilerPath <- expr $ buildPath (vanillaContext stage compiler)
|
|
21
|
|
-
|
|
22
|
|
- let -- Do not bind the result to a Boolean: this forces the configure rule
|
|
23
|
|
- -- immediately and may lead to cyclic dependencies.
|
|
24
|
|
- -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809.
|
|
25
|
|
- cross = flag CrossCompiling
|
|
26
|
|
- haveCurses = any (/= "") <$> traverse (flip buildSetting stage) [CursesIncludeDir, CursesLibDir]
|
|
27
|
|
-
|
|
28
|
|
- -- Check if the bootstrap compiler has the same version as the one we
|
|
29
|
|
- -- are building. This is used to build cross-compilers
|
|
30
|
|
- bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1
|
|
31
|
|
-
|
|
32
|
|
- compilerStageOption f = buildingCompilerStage' . f =<< expr flavour
|
|
33
|
|
-
|
|
34
|
|
- cursesIncludeDir <- staged (buildSetting CursesIncludeDir)
|
|
35
|
|
- cursesLibraryDir <- staged (buildSetting CursesLibDir)
|
|
36
|
|
- ffiIncludeDir <- staged (buildSetting FfiIncludeDir)
|
|
37
|
|
- ffiLibraryDir <- staged (buildSetting FfiLibDir)
|
|
38
|
|
- libzstdIncludeDir <- staged (buildSetting LibZstdIncludeDir)
|
|
39
|
|
- libzstdLibraryDir <- staged (buildSetting LibZstdLibDir)
|
|
40
|
|
- stageVersion <- readVersion <$> (expr $ ghcVersionStage stage)
|
|
41
|
|
-
|
|
42
|
|
- mconcat
|
|
43
|
|
- --------------------------------- base ---------------------------------
|
|
44
|
|
- [ package base
|
|
45
|
|
- ? mconcat
|
|
|
20
|
+ stage <- getStage
|
|
|
21
|
+ path <- getBuildPath
|
|
|
22
|
+ compilerPath <- expr $ buildPath (vanillaContext stage compiler)
|
|
|
23
|
+
|
|
|
24
|
+ let -- Do not bind the result to a Boolean: this forces the configure rule
|
|
|
25
|
+ -- immediately and may lead to cyclic dependencies.
|
|
|
26
|
+ -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809.
|
|
|
27
|
+ cross = flag CrossCompiling
|
|
|
28
|
+ haveCurses = any (/= "") <$> traverse (flip buildSetting stage) [CursesIncludeDir, CursesLibDir]
|
|
|
29
|
+
|
|
|
30
|
+ -- Check if the bootstrap compiler has the same version as the one we
|
|
|
31
|
+ -- are building. This is used to build cross-compilers
|
|
|
32
|
+ bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1
|
|
|
33
|
+
|
|
|
34
|
+ compilerStageOption f = buildingCompilerStage' . f =<< expr flavour
|
|
|
35
|
+
|
|
|
36
|
+ cursesIncludeDir <- staged (buildSetting CursesIncludeDir)
|
|
|
37
|
+ cursesLibraryDir <- staged (buildSetting CursesLibDir)
|
|
|
38
|
+ ffiIncludeDir <- staged (buildSetting FfiIncludeDir)
|
|
|
39
|
+ ffiLibraryDir <- staged (buildSetting FfiLibDir)
|
|
|
40
|
+ libzstdIncludeDir <- staged (buildSetting LibZstdIncludeDir)
|
|
|
41
|
+ libzstdLibraryDir <- staged (buildSetting LibZstdLibDir)
|
|
|
42
|
+ stageVersion <- readVersion <$> (expr $ ghcVersionStage stage)
|
|
|
43
|
+
|
|
|
44
|
+ mconcat
|
|
|
45
|
+ --------------------------------- base ---------------------------------
|
|
|
46
|
+ [ package base ? mconcat
|
|
46
|
47
|
[ -- This fixes the 'unknown symbol stat' issue.
|
|
47
|
48
|
-- See: https://github.com/snowleopard/hadrian/issues/259.
|
|
48
|
|
- builder (Ghc CompileCWithGhc) ? arg "-optc-O2"
|
|
49
|
|
- ],
|
|
50
|
|
- --------------------------------- cabal --------------------------------
|
|
51
|
|
- -- Cabal is a large library and slow to compile. Moreover, we build it
|
|
52
|
|
- -- for Stage0 only so we can link ghc-pkg against it, so there is little
|
|
53
|
|
- -- reason to spend the effort to optimise it.
|
|
54
|
|
- package cabal
|
|
55
|
|
- ? stage0
|
|
56
|
|
- ? builder Ghc
|
|
57
|
|
- ? arg "-O0",
|
|
58
|
|
- ------------------------------- compiler -------------------------------
|
|
59
|
|
- package compiler
|
|
60
|
|
- ? mconcat
|
|
61
|
|
- [ builder Alex ? arg "--latin1",
|
|
62
|
|
- builder (Ghc CompileHs)
|
|
63
|
|
- ? mconcat
|
|
64
|
|
- [ compilerStageOption ghcDebugAssertions ? arg "-DDEBUG",
|
|
65
|
|
- inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto",
|
|
66
|
|
- input "**/Parser.hs"
|
|
67
|
|
- ? pure ["-fno-ignore-interface-pragmas", "-fcmm-sink"],
|
|
68
|
|
- -- Enable -haddock and -Winvalid-haddock for the compiler
|
|
69
|
|
- arg "-haddock",
|
|
70
|
|
- notStage0 ? arg "-Winvalid-haddock",
|
|
71
|
|
- -- These files take a very long time to compile with -O1,
|
|
72
|
|
- -- so we use -O0 for them just in Stage0 to speed up the
|
|
73
|
|
- -- build but not affect Stage1+ executables
|
|
74
|
|
- inputs ["**/GHC/Hs/Instances.hs", "**/GHC/Driver/Session.hs"]
|
|
75
|
|
- ? stage0
|
|
76
|
|
- ? pure ["-O0"]
|
|
77
|
|
- ],
|
|
78
|
|
- builder (Cabal Setup)
|
|
79
|
|
- ? mconcat
|
|
80
|
|
- [ arg "--disable-library-for-ghci",
|
|
81
|
|
- anyTargetOs stage [OSOpenBSD] ? arg "--ld-options=-E",
|
|
82
|
|
- compilerStageOption ghcProfiled ? arg "--ghc-pkg-option=--force",
|
|
83
|
|
- cabalExtraDirs libzstdIncludeDir libzstdLibraryDir
|
|
84
|
|
- ],
|
|
85
|
|
- builder (Cabal Flags)
|
|
86
|
|
- ? mconcat
|
|
87
|
|
- -- In order to enable internal-interpreter for the ghc
|
|
88
|
|
- -- library:
|
|
89
|
|
- --
|
|
90
|
|
- -- 1. ghcWithInterpreter must be True ("Use interpreter" =
|
|
91
|
|
- -- "YES")
|
|
92
|
|
- -- 2. For non-cross case it can be enabled
|
|
93
|
|
- -- 3. For cross case, disable for stage0 since that runs
|
|
94
|
|
- -- on the host and must rely on external interpreter to
|
|
95
|
|
- -- load target code, otherwise enable for stage1 since
|
|
96
|
|
- -- that runs on the target and can use target's own
|
|
97
|
|
- -- ghci object linker
|
|
98
|
|
- [ andM [expr (ghcWithInterpreter stage), orM [notCross, stage2]] `cabalFlag` "internal-interpreter",
|
|
99
|
|
- orM [notM cross, haveCurses] `cabalFlag` "terminfo",
|
|
100
|
|
- flag UseLibzstd `cabalFlag` "with-libzstd",
|
|
101
|
|
- -- ROMES: While the boot compiler is not updated wrt -this-unit-id
|
|
102
|
|
- -- not being fixed to `ghc`, when building stage0, we must set
|
|
103
|
|
- -- -this-unit-id to `ghc` because the boot compiler expects that.
|
|
104
|
|
- -- We do it through a cabal flag in ghc.cabal
|
|
105
|
|
- stageVersion < makeVersion [9, 8, 1] ? arg "+hadrian-stage0",
|
|
106
|
|
- flag StaticLibzstd `cabalFlag` "static-libzstd",
|
|
107
|
|
- stage0 `cabalFlag` "bootstrap"
|
|
108
|
|
- ],
|
|
109
|
|
- builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path)
|
|
110
|
|
- ],
|
|
111
|
|
- ---------------------------------- ghc ---------------------------------
|
|
112
|
|
- package ghc
|
|
113
|
|
- ? mconcat
|
|
114
|
|
- [ builder Ghc
|
|
115
|
|
- ? mconcat
|
|
116
|
|
- [ arg ("-I" ++ compilerPath),
|
|
117
|
|
- compilerStageOption ghcDebugAssertions ? arg "-DDEBUG"
|
|
118
|
|
- ],
|
|
119
|
|
- builder (Cabal Flags)
|
|
120
|
|
- ? mconcat
|
|
121
|
|
- [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter",
|
|
122
|
|
- ifM
|
|
123
|
|
- stage0
|
|
124
|
|
- -- We build a threaded stage 1 if the bootstrapping compiler
|
|
125
|
|
- -- supports it.
|
|
126
|
|
- (threadedBootstrapper `cabalFlag` "threaded")
|
|
127
|
|
- -- We build a threaded stage N, N>1 if the configuration calls
|
|
128
|
|
- -- for it.
|
|
129
|
|
- (compilerStageOption ghcThreaded `cabalFlag` "threaded")
|
|
130
|
|
- ]
|
|
131
|
|
- ],
|
|
132
|
|
- -------------------------------- ghcPkg --------------------------------
|
|
133
|
|
- package ghcPkg
|
|
134
|
|
- ? builder (Cabal Flags)
|
|
135
|
|
- ? orM [notM cross, haveCurses]
|
|
136
|
|
- `cabalFlag` "terminfo",
|
|
137
|
|
- -------------------------------- ghcBoot ------------------------------
|
|
138
|
|
- package ghcBoot
|
|
139
|
|
- ? builder (Cabal Flags)
|
|
140
|
|
- ? (stage0 `cabalFlag` "bootstrap"),
|
|
141
|
|
- --------------------------------- ghci ---------------------------------
|
|
142
|
|
- package ghci
|
|
143
|
|
- ? mconcat
|
|
144
|
|
- [ -- The use case here is that we want to build @iserv-proxy@ for the
|
|
145
|
|
- -- cross compiler. That one needs to be compiled by the bootstrap
|
|
146
|
|
- -- compiler as it needs to run on the host. Hence @iserv@ needs
|
|
147
|
|
- -- @GHCi.TH@, @GHCi.Message@, @GHCi.Run@, and @GHCi.Server@ from
|
|
148
|
|
- -- @ghci@. And those are behind the @-finternal-interpreter@ flag.
|
|
149
|
|
- --
|
|
150
|
|
- -- But it may not build if we have made some changes to ghci's
|
|
151
|
|
- -- dependencies (see #16051).
|
|
152
|
|
- --
|
|
153
|
|
- -- To fix this properly Hadrian would need to:
|
|
154
|
|
- -- * first build a compiler for the build platform (stage1 is enough)
|
|
155
|
|
- -- * use it as a bootstrap compiler to build the stage1 cross-compiler
|
|
156
|
|
- --
|
|
157
|
|
- -- The issue is that "configure" would have to be executed twice (for
|
|
158
|
|
- -- the build platform and for the cross-platform) and Hadrian would
|
|
159
|
|
- -- need to be fixed to support two different stage1 compilers.
|
|
160
|
|
- --
|
|
161
|
|
- -- The workaround we use is to check if the bootstrap compiler has
|
|
162
|
|
- -- the same version as the one we are building. In this case we can
|
|
163
|
|
- -- avoid the first step above and directly build with
|
|
164
|
|
- -- `-finternal-interpreter`.
|
|
165
|
|
- --
|
|
166
|
|
- -- TODO: Note that in that case we also do not need to build most of
|
|
167
|
|
- -- the Stage1 libraries, as we already know that the bootstrap
|
|
168
|
|
- -- compiler comes with the same versions as the one we are building.
|
|
169
|
|
- --
|
|
170
|
|
- builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir,
|
|
171
|
|
- builder (Cabal Flags)
|
|
172
|
|
- ? mconcat
|
|
173
|
|
- [ ifM
|
|
174
|
|
- stage0
|
|
175
|
|
- (andM [cross, bootCross] `cabalFlag` "internal-interpreter")
|
|
176
|
|
- (arg "internal-interpreter"),
|
|
177
|
|
- stage0 `cabalFlag` "bootstrap"
|
|
178
|
|
- ]
|
|
179
|
|
- ],
|
|
180
|
|
- package unix ? builder (Cabal Flags) ? arg "+os-string",
|
|
181
|
|
- package directory ? builder (Cabal Flags) ? arg "+os-string",
|
|
182
|
|
- package win32 ? builder (Cabal Flags) ? arg "+os-string",
|
|
183
|
|
- --------------------------------- iserv --------------------------------
|
|
184
|
|
- -- Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
|
|
185
|
|
- -- refer to the RTS. This is harmless if you don't use it (adds a bit
|
|
186
|
|
- -- of overhead to startup and increases the binary sizes) but if you
|
|
187
|
|
- -- need it there's no alternative.
|
|
188
|
|
- --
|
|
189
|
|
- -- The Solaris linker does not support --export-dynamic option. It also
|
|
190
|
|
- -- does not need it since it exports all dynamic symbols by default
|
|
191
|
|
- package iserv
|
|
192
|
|
- ? expr (isElfTarget stage)
|
|
193
|
|
- ? notM (expr $ anyTargetOs stage [OSFreeBSD, OSSolaris2])
|
|
194
|
|
- ? mconcat
|
|
195
|
|
- [builder (Ghc LinkHs) ? arg "-optl-Wl,--export-dynamic"],
|
|
196
|
|
- -------------------------------- haddock -------------------------------
|
|
197
|
|
- package haddockApi
|
|
198
|
|
- ? builder (Cabal Flags)
|
|
199
|
|
- ? arg "in-ghc-tree",
|
|
200
|
|
- ---------------------------- ghc-boot-th-next --------------------------
|
|
201
|
|
- package ghcBootThNext
|
|
202
|
|
- ? builder (Cabal Flags)
|
|
203
|
|
- ? stage0
|
|
204
|
|
- `cabalFlag` "bootstrap",
|
|
205
|
|
- ---------------------------------- text --------------------------------
|
|
206
|
|
- package text
|
|
207
|
|
- ? ifM
|
|
208
|
|
- (textWithSIMDUTF <$> expr flavour)
|
|
209
|
|
- (builder (Cabal Flags) ? arg "+simdutf")
|
|
210
|
|
- (builder (Cabal Flags) ? arg "-simdutf"),
|
|
211
|
|
- ------------------------------- haskeline ------------------------------
|
|
212
|
|
- -- Hadrian doesn't currently support packages containing both libraries
|
|
213
|
|
- -- and executables. This flag disables the latter.
|
|
214
|
|
- package haskeline
|
|
215
|
|
- ? builder (Cabal Flags)
|
|
216
|
|
- ? arg "-examples",
|
|
217
|
|
- -- Don't depend upon terminfo when cross-compiling to avoid unnecessary
|
|
218
|
|
- -- dependencies unless the user provided ncurses explicitly.
|
|
219
|
|
- -- TODO: Perhaps the user should be able to explicitly enable/disable this.
|
|
220
|
|
- package haskeline
|
|
221
|
|
- ? builder (Cabal Flags)
|
|
222
|
|
- ? orM [notM cross, haveCurses]
|
|
223
|
|
- `cabalFlag` "terminfo",
|
|
224
|
|
- -------------------------------- terminfo ------------------------------
|
|
225
|
|
- package terminfo
|
|
226
|
|
- ? builder (Cabal Setup)
|
|
227
|
|
- ? cabalExtraDirs cursesIncludeDir cursesLibraryDir,
|
|
228
|
|
- -------------------------------- hsc2hs --------------------------------
|
|
229
|
|
- package hsc2hs
|
|
230
|
|
- ? builder (Cabal Flags)
|
|
231
|
|
- ? arg "in-ghc-tree",
|
|
232
|
|
- ------------------------------ ghc-internal ------------------------------
|
|
233
|
|
- ghcInternalArgs,
|
|
234
|
|
- ---------------------------------- rts ---------------------------------
|
|
235
|
|
- package rts ? rtsPackageArgs, -- RTS deserves a separate function
|
|
|
49
|
+ builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ]
|
|
236
|
50
|
|
|
237
|
51
|
--------------------------------- cabal --------------------------------
|
|
238
|
52
|
-- Cabal is a large library and slow to compile. Moreover, we build it
|
| ... |
... |
@@ -268,25 +82,28 @@ packageArgs = do |
|
268
|
82
|
]
|
|
269
|
83
|
|
|
270
|
84
|
, builder (Cabal Flags) ? mconcat
|
|
271
|
|
- -- For the ghc library, internal-interpreter only makes
|
|
272
|
|
- -- sense when we're not cross compiling. For cross GHC,
|
|
273
|
|
- -- external interpreter is used for loading target code
|
|
274
|
|
- -- and internal interpreter is supposed to load native
|
|
275
|
|
- -- code for plugins (!7377), however it's unfinished work
|
|
276
|
|
- -- (#14335) and completely untested in CI for cross
|
|
277
|
|
- -- backends at the moment, so we might as well disable it
|
|
278
|
|
- -- for cross GHC.
|
|
279
|
|
- -- TODO: MP
|
|
280
|
|
- [ andM [expr (ghcWithInterpreter stage)] `cabalFlag` "internal-interpreter"
|
|
|
85
|
+ -- In order to enable internal-interpreter for the ghc
|
|
|
86
|
+ -- library:
|
|
|
87
|
+ --
|
|
|
88
|
+ -- 1. ghcWithInterpreter must be True ("Use interpreter" =
|
|
|
89
|
+ -- "YES")
|
|
|
90
|
+ -- 2. For non-cross case it can be enabled
|
|
|
91
|
+ -- 3. For cross case, disable for stage0 since that runs
|
|
|
92
|
+ -- on the host and must rely on external interpreter to
|
|
|
93
|
+ -- load target code, otherwise enable for stage1 since
|
|
|
94
|
+ -- that runs on the target and can use target's own
|
|
|
95
|
+ -- ghci object linker
|
|
|
96
|
+ [ andM [expr (ghcWithInterpreter stage), orM [notM (expr cross), stage2]] `cabalFlag` "internal-interpreter"
|
|
281
|
97
|
, orM [ notM cross, haveCurses ] `cabalFlag` "terminfo"
|
|
|
98
|
+ , arg "-build-tool-depends"
|
|
282
|
99
|
, staged (buildFlag UseLibzstd) `cabalFlag` "with-libzstd"
|
|
283
|
100
|
-- ROMES: While the boot compiler is not updated wrt -this-unit-id
|
|
284
|
101
|
-- not being fixed to `ghc`, when building stage0, we must set
|
|
285
|
102
|
-- -this-unit-id to `ghc` because the boot compiler expects that.
|
|
286
|
103
|
-- We do it through a cabal flag in ghc.cabal
|
|
287
|
104
|
, stageVersion < makeVersion [9,8,1] ? arg "+hadrian-stage0"
|
|
288
|
|
- , stage0 `cabalFlag` "bootstrap"
|
|
289
|
105
|
, staged (buildFlag StaticLibzstd) `cabalFlag` "static-libzstd"
|
|
|
106
|
+ , stage0 `cabalFlag` "bootstrap"
|
|
290
|
107
|
]
|
|
291
|
108
|
|
|
292
|
109
|
, builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]
|
| ... |
... |
@@ -414,24 +231,22 @@ packageArgs = do |
|
414
|
231
|
, package rts ? rtsPackageArgs -- RTS deserves a separate function
|
|
415
|
232
|
|
|
416
|
233
|
-------------------------------- runGhc --------------------------------
|
|
417
|
|
- , package runGhc
|
|
418
|
|
- ? builder Ghc
|
|
419
|
|
- ? input "**/Main.hs"
|
|
420
|
|
- ? (\version -> ["-cpp", "-DVERSION=" ++ show version])
|
|
421
|
|
- <$> getSetting ProjectVersion
|
|
|
234
|
+ , package runGhc ?
|
|
|
235
|
+ builder Ghc ? input "**/Main.hs" ?
|
|
|
236
|
+ (\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion
|
|
|
237
|
+
|
|
422
|
238
|
--------------------------------- genprimopcode ------------------------
|
|
423
|
239
|
, package genprimopcode
|
|
424
|
|
- ? builder (Cabal Flags)
|
|
425
|
|
- ? arg "-build-tool-depends"
|
|
|
240
|
+ ? builder (Cabal Flags) ? arg "-build-tool-depends"
|
|
|
241
|
+
|
|
426
|
242
|
--------------------------------- hpcBin ----------------------------------
|
|
427
|
243
|
, package hpcBin
|
|
428
|
|
- ? builder (Cabal Flags)
|
|
429
|
|
- ? arg "-build-tool-depends"
|
|
|
244
|
+ ? builder (Cabal Flags) ? arg "-build-tool-depends"
|
|
|
245
|
+
|
|
430
|
246
|
]
|
|
431
|
247
|
|
|
432
|
248
|
ghcInternalArgs :: Args
|
|
433
|
|
-ghcInternalArgs =
|
|
434
|
|
- package ghcInternal ? do
|
|
|
249
|
+ghcInternalArgs = package ghcInternal ? do
|
|
435
|
250
|
-- These are only used for non-in-tree builds.
|
|
436
|
251
|
librariesGmp <- staged (buildSetting GmpLibDir)
|
|
437
|
252
|
includesGmp <- staged (buildSetting GmpIncludeDir)
|
| ... |
... |
@@ -442,23 +257,27 @@ ghcInternalArgs = |
|
442
|
257
|
mconcat
|
|
443
|
258
|
[ -- select bignum backend
|
|
444
|
259
|
builder (Cabal Flags) ? arg ("bignum-" <> backend)
|
|
|
260
|
+
|
|
445
|
261
|
, -- check the selected backend against native backend
|
|
446
|
262
|
builder (Cabal Flags) ? check `cabalFlag` "bignum-check"
|
|
|
263
|
+
|
|
447
|
264
|
-- backend specific
|
|
448
|
265
|
, case backend of
|
|
449
|
|
- "gmp" ->
|
|
450
|
|
- mconcat
|
|
451
|
|
- [ builder (Cabal Setup)
|
|
452
|
|
- ? mconcat
|
|
|
266
|
+ "gmp" -> mconcat
|
|
|
267
|
+ [ builder (Cabal Setup) ? mconcat
|
|
|
268
|
+
|
|
453
|
269
|
-- enable GMP backend: configure script will produce
|
|
454
|
270
|
-- `ghc-internal.buildinfo` and `include/HsIntegerGmp.h`
|
|
455
|
271
|
[ arg "--configure-option=--with-gmp"
|
|
|
272
|
+
|
|
456
|
273
|
-- enable in-tree support: don't depend on external "gmp"
|
|
457
|
274
|
-- library
|
|
458
|
275
|
, staged (buildFlag GmpInTree) ? arg "--configure-option=--with-intree-gmp"
|
|
|
276
|
+
|
|
459
|
277
|
-- prefer framework over library (on Darwin)
|
|
460
|
278
|
, staged (buildFlag GmpFrameworkPref)
|
|
461
|
279
|
? arg "--configure-option=--with-gmp-framework-preferred"
|
|
|
280
|
+
|
|
462
|
281
|
-- Ensure that the ghc-internal package registration includes
|
|
463
|
282
|
-- knowledge of the system gmp's library and include directories.
|
|
464
|
283
|
, notM (staged (buildFlag GmpInTree)) ? cabalExtraDirs includesGmp librariesGmp
|
| ... |
... |
@@ -467,28 +286,27 @@ ghcInternalArgs = |
|
467
|
286
|
_ -> mempty
|
|
468
|
287
|
|
|
469
|
288
|
, builder (Cabal Flags) ? staged (buildFlag NeedLibatomic) `cabalFlag` "need-atomic"
|
|
470
|
|
- , builder (Cc CompileC)
|
|
471
|
|
- ? (not <$> staged (buildFlag CcLlvmBackend))
|
|
472
|
|
- ? input "**/cbits/atomic.c"
|
|
473
|
|
- ? arg "-Wno-sync-nand"
|
|
|
289
|
+
|
|
|
290
|
+ , builder (Cc CompileC) ? (not <$> staged (buildFlag CcLlvmBackend)) ?
|
|
|
291
|
+ input "**/cbits/atomic.c" ? arg "-Wno-sync-nand"
|
|
|
292
|
+
|
|
474
|
293
|
]
|
|
475
|
294
|
|
|
476
|
295
|
-- | RTS-specific command line arguments.
|
|
477
|
296
|
rtsPackageArgs :: Args
|
|
478
|
|
-rtsPackageArgs =
|
|
479
|
|
- package rts ? do
|
|
480
|
|
- stage <- getStage
|
|
481
|
|
- ghcUnreg <- queryTarget stage tgtUnregisterised
|
|
482
|
|
- ghcEnableTNC <- queryTarget stage tgtTablesNextToCode
|
|
483
|
|
- rtsWays <- getRtsWays
|
|
484
|
|
- way <- getWay
|
|
485
|
|
- path <- getBuildPath
|
|
486
|
|
- top <- expr topDirectory
|
|
|
297
|
+rtsPackageArgs = package rts ? do
|
|
|
298
|
+ stage <- getStage
|
|
|
299
|
+ ghcUnreg <- queryTarget stage tgtUnregisterised
|
|
|
300
|
+ ghcEnableTNC <- queryTarget stage tgtTablesNextToCode
|
|
|
301
|
+ rtsWays <- getRtsWays
|
|
|
302
|
+ way <- getWay
|
|
|
303
|
+ path <- getBuildPath
|
|
|
304
|
+ top <- expr topDirectory
|
|
487
|
305
|
useSystemFfi <- succStaged (buildFlag UseSystemFfi)
|
|
488
|
|
- ffiIncludeDir <- staged (buildSetting FfiIncludeDir)
|
|
489
|
|
- ffiLibraryDir <- staged (buildSetting FfiLibDir)
|
|
490
|
|
- libdwIncludeDir <- staged (\s -> queryTargetTarget s (Lib.includePath <=< tgtRTSWithLibdw))
|
|
491
|
|
- libdwLibraryDir <- staged (\s -> queryTargetTarget s (Lib.libraryPath <=< tgtRTSWithLibdw))
|
|
|
306
|
+ ffiIncludeDir <- staged (buildSetting FfiIncludeDir)
|
|
|
307
|
+ ffiLibraryDir <- staged (buildSetting FfiLibDir)
|
|
|
308
|
+ libdwIncludeDir <- staged (\s -> queryTargetTarget s (Lib.includePath <=< tgtRTSWithLibdw))
|
|
|
309
|
+ libdwLibraryDir <- staged (\s -> queryTargetTarget s (Lib.libraryPath <=< tgtRTSWithLibdw))
|
|
492
|
310
|
libnumaIncludeDir <- staged (buildSetting LibnumaIncludeDir)
|
|
493
|
311
|
libnumaLibraryDir <- staged (buildSetting LibnumaLibDir)
|
|
494
|
312
|
libzstdIncludeDir <- staged (buildSetting LibZstdIncludeDir)
|
| ... |
... |
@@ -506,11 +324,12 @@ rtsPackageArgs = |
|
506
|
324
|
let ghcArgs = mconcat
|
|
507
|
325
|
[ arg "-Irts"
|
|
508
|
326
|
, arg $ "-I" ++ path
|
|
509
|
|
- , notM (targetSupportsSMP stage) ? arg "-DNOSMP"
|
|
510
|
327
|
, way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY"
|
|
511
|
328
|
, "-optc-DTICKY_TICKY"]
|
|
512
|
329
|
, Profiling `wayUnit` way ? arg "-DPROFILING"
|
|
513
|
330
|
, Threaded `wayUnit` way ? arg "-DTHREADED_RTS"
|
|
|
331
|
+ , notM (targetSupportsSMP stage) ? arg "-DNOSMP"
|
|
|
332
|
+
|
|
514
|
333
|
-- See Note [AutoApply.cmm for vectors] in genapply/Main.hs
|
|
515
|
334
|
--
|
|
516
|
335
|
-- In particular, we **do not** pass -mavx when compiling
|
| ... |
... |
@@ -520,7 +339,6 @@ rtsPackageArgs = |
|
520
|
339
|
|
|
521
|
340
|
, inputs ["**/Jumps_V32.cmm"] ? pure [ "-mavx2" | x86Host ]
|
|
522
|
341
|
, inputs ["**/Jumps_V64.cmm"] ? pure [ "-mavx512f" | x86Host ]
|
|
523
|
|
- , notM (targetSupportsSMP stage) ? arg "-optc-DNOSMP"
|
|
524
|
342
|
]
|
|
525
|
343
|
|
|
526
|
344
|
let cArgs = mconcat
|
| ... |
... |
@@ -558,92 +376,91 @@ rtsPackageArgs = |
|
558
|
376
|
[ "-DRtsWay=\"rts_" ++ show way ++ "\""
|
|
559
|
377
|
]
|
|
560
|
378
|
|
|
561
|
|
- let cArgs =
|
|
562
|
|
- mconcat
|
|
563
|
|
- [ rtsWarnings,
|
|
564
|
|
- wayCcArgs,
|
|
565
|
|
- arg "-fomit-frame-pointer",
|
|
566
|
|
- -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
|
|
567
|
|
- -- requires that functions are inlined to work as expected. Inlining
|
|
568
|
|
- -- only happens for optimised builds. Otherwise we can assume that
|
|
569
|
|
- -- there is a non-inlined variant to use instead. But RTS does not
|
|
570
|
|
- -- provide non-inlined alternatives and hence needs the function to
|
|
571
|
|
- -- be inlined. See https://github.com/snowleopard/hadrian/issues/90.
|
|
572
|
|
- arg "-O2",
|
|
573
|
|
- arg "-Irts",
|
|
574
|
|
- arg $ "-I" ++ path,
|
|
575
|
|
- notM (targetSupportsSMP stage) ? arg "-DNOSMP",
|
|
576
|
|
- Debug
|
|
577
|
|
- `wayUnit` way
|
|
578
|
|
- ? pure
|
|
579
|
|
- [ "-DDEBUG",
|
|
580
|
|
- "-fno-omit-frame-pointer",
|
|
581
|
|
- "-g3",
|
|
582
|
|
- "-O0"
|
|
583
|
|
- ],
|
|
584
|
|
- -- Set the namespace for the rts fs functions
|
|
585
|
|
- arg $ "-DFS_NAMESPACE=rts",
|
|
586
|
|
- arg $ "-DCOMPILING_RTS",
|
|
587
|
|
- inputs ["**/RtsMessages.c", "**/Trace.c"]
|
|
588
|
|
- ? pure
|
|
589
|
|
- [ "-DRtsWay=\"rts_" ++ show way ++ "\""
|
|
590
|
|
- ],
|
|
591
|
|
- input "**/RtsUtils.c"
|
|
592
|
|
- ? pure
|
|
593
|
|
- [ "-DRtsWay=\"rts_" ++ show way ++ "\""
|
|
594
|
|
- ],
|
|
595
|
|
- -- We're after pure performance here. So make sure fast math and
|
|
596
|
|
- -- vectorization is enabled.
|
|
597
|
|
- input "**/Hash.c" ? pure ["-O3"],
|
|
598
|
|
- inputs ["**/Evac.c", "**/Evac_thr.c"] ? arg "-funroll-loops",
|
|
599
|
|
- speedHack stage
|
|
600
|
|
- ? inputs
|
|
601
|
|
- [ "**/Evac.c",
|
|
602
|
|
- "**/Evac_thr.c",
|
|
603
|
|
- "**/Scav.c",
|
|
604
|
|
- "**/Scav_thr.c",
|
|
605
|
|
- "**/Compact.c",
|
|
606
|
|
- "**/GC.c"
|
|
607
|
|
- ]
|
|
608
|
|
- ? arg "-fno-PIC",
|
|
609
|
|
- -- @-static@ is necessary for these bits, as otherwise the NCG
|
|
610
|
|
- -- generates dynamic references.
|
|
611
|
|
- speedHack stage
|
|
612
|
|
- ? inputs
|
|
613
|
|
- [ "**/Updates.c",
|
|
614
|
|
- "**/StgMiscClosures.c",
|
|
615
|
|
- "**/Jumps_D.c",
|
|
616
|
|
- "**/Jumps_V16.c",
|
|
617
|
|
- "**/Jumps_V32.c",
|
|
618
|
|
- "**/Jumps_V64.c",
|
|
619
|
|
- "**/PrimOps.c",
|
|
620
|
|
- "**/Apply.c",
|
|
621
|
|
- "**/AutoApply.c",
|
|
622
|
|
- "**/AutoApply_V16.c",
|
|
623
|
|
- "**/AutoApply_V32.c",
|
|
624
|
|
- "**/AutoApply_V64.c"
|
|
625
|
|
- ]
|
|
626
|
|
- ? pure ["-fno-PIC", "-static"],
|
|
627
|
|
- -- See Note [AutoApply.cmm for vectors] in genapply/Main.hs
|
|
628
|
|
- inputs ["**/AutoApply_V32.c"] ? pure ["-mavx2" | x86],
|
|
629
|
|
- inputs ["**/AutoApply_V64.c"] ? pure ["-mavx512f" | x86],
|
|
630
|
|
- inputs ["**/Jumps_V32.c"] ? pure ["-mavx2" | x86],
|
|
631
|
|
- inputs ["**/Jumps_V64.c"] ? pure ["-mavx512f" | x86],
|
|
632
|
|
- -- inlining warnings happen in Compact
|
|
633
|
|
- inputs ["**/Compact.c"] ? arg "-Wno-inline",
|
|
634
|
|
- -- emits warnings about call-clobbered registers on x86_64
|
|
635
|
|
- inputs
|
|
636
|
|
- [ "**/StgCRun.c",
|
|
637
|
|
- "**/win32/ConsoleHandler.c",
|
|
638
|
|
- "**/win32/ThrIOManager.c"
|
|
639
|
|
- ]
|
|
640
|
|
- ? arg "-w",
|
|
641
|
|
- -- The above warning suppression flags are a temporary kludge.
|
|
642
|
|
- -- While working on this module you are encouraged to remove it and fix
|
|
643
|
|
- -- any warnings in the module. See:
|
|
644
|
|
- -- https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions#Warnings
|
|
|
379
|
+ -- We're after pure performance here. So make sure fast math and
|
|
|
380
|
+ -- vectorization is enabled.
|
|
|
381
|
+ , input "**/Hash.c" ? pure [ "-O3" ]
|
|
|
382
|
+
|
|
|
383
|
+ , inputs ["**/Evac.c", "**/Evac_thr.c"] ? arg "-funroll-loops"
|
|
|
384
|
+
|
|
|
385
|
+ , speedHack stage ?
|
|
|
386
|
+ inputs [ "**/Evac.c", "**/Evac_thr.c"
|
|
|
387
|
+ , "**/Scav.c", "**/Scav_thr.c"
|
|
|
388
|
+ , "**/Compact.c", "**/GC.c" ] ? arg "-fno-PIC"
|
|
|
389
|
+ -- @-static@ is necessary for these bits, as otherwise the NCG
|
|
|
390
|
+ -- generates dynamic references.
|
|
|
391
|
+ , speedHack stage ?
|
|
|
392
|
+ inputs [ "**/Updates.c", "**/StgMiscClosures.c"
|
|
|
393
|
+ , "**/Jumps_D.c", "**/Jumps_V16.c", "**/Jumps_V32.c", "**/Jumps_V64.c"
|
|
|
394
|
+ , "**/PrimOps.c", "**/Apply.c"
|
|
|
395
|
+ , "**/AutoApply.c"
|
|
|
396
|
+ , "**/AutoApply_V16.c"
|
|
|
397
|
+ , "**/AutoApply_V32.c"
|
|
|
398
|
+ , "**/AutoApply_V64.c" ] ? pure ["-fno-PIC", "-static"]
|
|
|
399
|
+
|
|
|
400
|
+ -- See Note [AutoApply.cmm for vectors] in genapply/Main.hs
|
|
|
401
|
+ , inputs ["**/AutoApply_V32.c"] ? pure [ "-mavx2" | x86Host ]
|
|
|
402
|
+ , inputs ["**/AutoApply_V64.c"] ? pure [ "-mavx512f" | x86Host ]
|
|
|
403
|
+
|
|
|
404
|
+ , inputs ["**/Jumps_V32.c"] ? pure [ "-mavx2" | x86Host ]
|
|
|
405
|
+ , inputs ["**/Jumps_V64.c"] ? pure [ "-mavx512f" | x86Host ]
|
|
|
406
|
+
|
|
|
407
|
+ -- inlining warnings happen in Compact
|
|
|
408
|
+ , inputs ["**/Compact.c"] ? arg "-Wno-inline"
|
|
|
409
|
+
|
|
|
410
|
+ -- emits warnings about call-clobbered registers on x86_64
|
|
|
411
|
+ , inputs [ "**/StgCRun.c"
|
|
|
412
|
+ , "**/win32/ConsoleHandler.c", "**/win32/ThrIOManager.c"] ? arg "-w"
|
|
|
413
|
+ -- The above warning suppression flags are a temporary kludge.
|
|
|
414
|
+ -- While working on this module you are encouraged to remove it and fix
|
|
|
415
|
+ -- any warnings in the module. See:
|
|
|
416
|
+ -- https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions#Warnings
|
|
|
417
|
+
|
|
|
418
|
+ , (not <$> (staged (buildFlag CcLlvmBackend))) ?
|
|
|
419
|
+ inputs ["**/Compact.c"] ? arg "-finline-limit=2500"
|
|
|
420
|
+
|
|
|
421
|
+ , input "**/RetainerProfile.c" ? staged (buildFlag CcLlvmBackend) ?
|
|
|
422
|
+ arg "-Wno-incompatible-pointer-types"
|
|
|
423
|
+ ]
|
|
|
424
|
+
|
|
|
425
|
+ mconcat
|
|
|
426
|
+ [ builder (Cabal Flags) ? mconcat
|
|
|
427
|
+ [ any (wayUnit Profiling) rtsWays `cabalFlag` "profiling"
|
|
|
428
|
+ , any (wayUnit Debug) rtsWays `cabalFlag` "debug"
|
|
|
429
|
+ , any (wayUnit Dynamic) rtsWays `cabalFlag` "dynamic"
|
|
|
430
|
+ , any (wayUnit Threaded) rtsWays `cabalFlag` "threaded"
|
|
|
431
|
+ , buildFlag UseLibm stage `cabalFlag` "libm"
|
|
|
432
|
+ , buildFlag UseLibrt stage `cabalFlag` "librt"
|
|
|
433
|
+ , buildFlag UseLibdl stage `cabalFlag` "libdl"
|
|
|
434
|
+ , useSystemFfi `cabalFlag` "use-system-libffi"
|
|
|
435
|
+ , targetUseLibffiForAdjustors stage `cabalFlag` "libffi-adjustors"
|
|
|
436
|
+ , buildFlag UseLibpthread stage `cabalFlag` "need-pthread"
|
|
|
437
|
+ , buildFlag UseLibbfd stage `cabalFlag` "libbfd"
|
|
|
438
|
+ , buildFlag NeedLibatomic stage `cabalFlag` "need-atomic"
|
|
|
439
|
+ , useLibdw stage `cabalFlag` "libdw"
|
|
|
440
|
+ , buildFlag UseLibnuma stage `cabalFlag` "libnuma"
|
|
|
441
|
+ , buildFlag UseLibzstd stage `cabalFlag` "libzstd"
|
|
|
442
|
+ , buildFlag StaticLibzstd stage `cabalFlag` "static-libzstd"
|
|
|
443
|
+ , queryTargetTarget stage tgtSymbolsHaveLeadingUnderscore `cabalFlag` "leading-underscore"
|
|
|
444
|
+ , ghcUnreg `cabalFlag` "unregisterised"
|
|
|
445
|
+ , ghcEnableTNC `cabalFlag` "tables-next-to-code"
|
|
|
446
|
+ , Debug `wayUnit` way `cabalFlag` "find-ptr"
|
|
|
447
|
+ ]
|
|
|
448
|
+ , builder (Cabal Setup) ? mconcat
|
|
|
449
|
+ [ useLibdw stage ? cabalExtraDirs (fromMaybe "" libdwIncludeDir) (fromMaybe "" libdwLibraryDir)
|
|
|
450
|
+ , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir
|
|
|
451
|
+ , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir
|
|
|
452
|
+ , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir
|
|
|
453
|
+ ]
|
|
|
454
|
+ , builder (Cc (FindCDependencies CDep)) ? cArgs
|
|
|
455
|
+ , builder (Cc (FindCDependencies CxxDep)) ? cArgs
|
|
|
456
|
+ , builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
|
|
|
457
|
+ , builder (Ghc CompileCppWithGhc) ? map ("-optcxx" ++) <$> cArgs
|
|
|
458
|
+ , builder Ghc ? ghcArgs
|
|
645
|
459
|
|
|
|
460
|
+ , builder HsCpp ? pure
|
|
|
461
|
+ [ "-DTOP=" ++ show top ]
|
|
646
|
462
|
|
|
|
463
|
+ , builder HsCpp ? useLibdw stage ? arg "-DUSE_LIBDW" ]
|
|
647
|
464
|
|
|
648
|
465
|
-- Compile various performance-critical pieces *without* -fPIC -dynamic
|
|
649
|
466
|
-- even when building a shared library. If we don't do this, then the
|
| ... |
... |
@@ -677,43 +494,37 @@ rtsPackageArgs = |
|
677
|
494
|
-- collect2: ld returned 1 exit status
|
|
678
|
495
|
speedHack :: Stage -> Action Bool
|
|
679
|
496
|
speedHack stage = do
|
|
680
|
|
- i386 <- anyTargetArch stage [ArchX86]
|
|
|
497
|
+ i386 <- anyTargetArch stage [ArchX86]
|
|
681
|
498
|
goodOS <- not <$> anyTargetOs stage [OSSolaris2]
|
|
682
|
499
|
return $ i386 && goodOS
|
|
683
|
500
|
|
|
684
|
501
|
-- See @rts/ghc.mk@.
|
|
685
|
502
|
rtsWarnings :: Args
|
|
686
|
|
-rtsWarnings =
|
|
687
|
|
- mconcat
|
|
688
|
|
- [ arg "-Wall",
|
|
689
|
|
- arg "-Wextra",
|
|
690
|
|
- arg "-Wstrict-prototypes",
|
|
691
|
|
- arg "-Wmissing-prototypes",
|
|
692
|
|
- arg "-Wmissing-declarations",
|
|
693
|
|
- arg "-Winline",
|
|
694
|
|
- arg "-Wpointer-arith",
|
|
695
|
|
- arg "-Wmissing-noreturn",
|
|
696
|
|
- arg "-Wnested-externs",
|
|
697
|
|
- arg "-Wredundant-decls",
|
|
698
|
|
- arg "-Wundef",
|
|
699
|
|
- arg "-fno-strict-aliasing"
|
|
700
|
|
- ]
|
|
|
503
|
+rtsWarnings = mconcat
|
|
|
504
|
+ [ arg "-Wall"
|
|
|
505
|
+ , arg "-Wextra"
|
|
|
506
|
+ , arg "-Wstrict-prototypes"
|
|
|
507
|
+ , arg "-Wmissing-prototypes"
|
|
|
508
|
+ , arg "-Wmissing-declarations"
|
|
|
509
|
+ , arg "-Winline"
|
|
|
510
|
+ , arg "-Wpointer-arith"
|
|
|
511
|
+ , arg "-Wmissing-noreturn"
|
|
|
512
|
+ , arg "-Wnested-externs"
|
|
|
513
|
+ , arg "-Wredundant-decls"
|
|
|
514
|
+ , arg "-Wundef"
|
|
|
515
|
+ , arg "-fno-strict-aliasing" ]
|
|
701
|
516
|
|
|
702
|
517
|
-- | Expands to Cabal `--extra-lib-dirs` and `--extra-include-dirs` flags if
|
|
703
|
518
|
-- the respective paths are not null.
|
|
704
|
|
-cabalExtraDirs ::
|
|
705
|
|
- -- | include path
|
|
706
|
|
- FilePath ->
|
|
707
|
|
- -- | libraries path
|
|
708
|
|
- FilePath ->
|
|
709
|
|
- Args
|
|
710
|
|
-cabalExtraDirs include lib =
|
|
711
|
|
- mconcat
|
|
712
|
|
- [ extraDirFlag "--extra-lib-dirs" lib,
|
|
713
|
|
- extraDirFlag "--extra-include-dirs" include
|
|
|
519
|
+cabalExtraDirs :: FilePath -- ^ include path
|
|
|
520
|
+ -> FilePath -- ^ libraries path
|
|
|
521
|
+ -> Args
|
|
|
522
|
+cabalExtraDirs include lib = mconcat
|
|
|
523
|
+ [ extraDirFlag "--extra-lib-dirs" lib
|
|
|
524
|
+ , extraDirFlag "--extra-include-dirs" include
|
|
714
|
525
|
]
|
|
715
|
526
|
where
|
|
716
|
527
|
extraDirFlag :: String -> FilePath -> Args
|
|
717
|
528
|
extraDirFlag flag dir
|
|
718
|
|
- | null dir = mempty
|
|
719
|
|
- | otherwise = arg (flag ++ "=" ++ dir) |
|
|
529
|
+ | null dir = mempty
|
|
|
530
|
+ | otherwise = arg (flag++"="++dir) |