Cache the fingerprint of sOpt_P
[ghc.git] / compiler / main / SysTools.hs
1 {-
2 -----------------------------------------------------------------------------
3 --
4 -- (c) The University of Glasgow 2001-2003
5 --
6 -- Access to system tools: gcc, cp, rm etc
7 --
8 -----------------------------------------------------------------------------
9 -}
10
11 {-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-}
12
13 module SysTools (
14 -- * Initialisation
15 initSysTools,
16 initLlvmTargets,
17
18 -- * Interface to system tools
19 module SysTools.Tasks,
20 module SysTools.Info,
21
22 linkDynLib,
23
24 copy,
25 copyWithHeader,
26
27 -- * General utilities
28 Option(..),
29 expandTopDir,
30
31 -- * Platform-specifics
32 libmLinkOpts,
33
34 -- * Mac OS X frameworks
35 getPkgFrameworkOpts,
36 getFrameworkOpts
37 ) where
38
39 #include "HsVersions.h"
40
41 import GhcPrelude
42
43 import Module
44 import Packages
45 import Config
46 import Outputable
47 import ErrUtils
48 import Platform
49 import Util
50 import DynFlags
51 import Fingerprint
52
53 import System.FilePath
54 import System.IO
55 import System.Directory
56 import SysTools.ExtraObj
57 import SysTools.Info
58 import SysTools.Tasks
59 import SysTools.BaseDir
60
61 {-
62 Note [How GHC finds toolchain utilities]
63 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
64
65 SysTools.initSysProgs figures out exactly where all the auxiliary programs
66 are, and initialises mutable variables to make it easy to call them.
67 To do this, it makes use of definitions in Config.hs, which is a Haskell
68 file containing variables whose value is figured out by the build system.
69
70 Config.hs contains two sorts of things
71
72 cGCC, The *names* of the programs
73 cCPP e.g. cGCC = gcc
74 cUNLIT cCPP = gcc -E
75 etc They do *not* include paths
76
77
78 cUNLIT_DIR The *path* to the directory containing unlit, split etc
79 cSPLIT_DIR *relative* to the root of the build tree,
80 for use when running *in-place* in a build tree (only)
81
82
83 ---------------------------------------------
84 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
85
86 Another hair-brained scheme for simplifying the current tool location
87 nightmare in GHC: Simon originally suggested using another
88 configuration file along the lines of GCC's specs file - which is fine
89 except that it means adding code to read yet another configuration
90 file. What I didn't notice is that the current package.conf is
91 general enough to do this:
92
93 Package
94 {name = "tools", import_dirs = [], source_dirs = [],
95 library_dirs = [], hs_libraries = [], extra_libraries = [],
96 include_dirs = [], c_includes = [], package_deps = [],
97 extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${topdir}/bin/unlit", ... etc.],
98 extra_cc_opts = [], extra_ld_opts = []}
99
100 Which would have the advantage that we get to collect together in one
101 place the path-specific package stuff with the path-specific tool
102 stuff.
103 End of NOTES
104 ---------------------------------------------
105
106 ************************************************************************
107 * *
108 \subsection{Initialisation}
109 * *
110 ************************************************************************
111 -}
112
113 initLlvmTargets :: Maybe String
114 -> IO LlvmTargets
115 initLlvmTargets mbMinusB
116 = do top_dir <- findTopDir mbMinusB
117 let llvmTargetsFile = top_dir </> "llvm-targets"
118 llvmTargetsStr <- readFile llvmTargetsFile
119 case maybeReadFuzzy llvmTargetsStr of
120 Just s -> return (fmap mkLlvmTarget <$> s)
121 Nothing -> pgmError ("Can't parse " ++ show llvmTargetsFile)
122 where
123 mkLlvmTarget :: (String, String, String) -> LlvmTarget
124 mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)
125
126
127 initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix)
128 -> IO Settings -- Set all the mutable variables above, holding
129 -- (a) the system programs
130 -- (b) the package-config file
131 -- (c) the GHC usage message
132 initSysTools mbMinusB
133 = do top_dir <- findTopDir mbMinusB
134 -- see Note [topdir: How GHC finds its files]
135 -- NB: top_dir is assumed to be in standard Unix
136 -- format, '/' separated
137
138 let settingsFile = top_dir </> "settings"
139 platformConstantsFile = top_dir </> "platformConstants"
140 installed :: FilePath -> FilePath
141 installed file = top_dir </> file
142 libexec :: FilePath -> FilePath
143 libexec file = top_dir </> "bin" </> file
144
145 settingsStr <- readFile settingsFile
146 platformConstantsStr <- readFile platformConstantsFile
147 mySettings <- case maybeReadFuzzy settingsStr of
148 Just s ->
149 return s
150 Nothing ->
151 pgmError ("Can't parse " ++ show settingsFile)
152 platformConstants <- case maybeReadFuzzy platformConstantsStr of
153 Just s ->
154 return s
155 Nothing ->
156 pgmError ("Can't parse " ++
157 show platformConstantsFile)
158 let getSetting key = case lookup key mySettings of
159 Just xs -> return $ expandTopDir top_dir xs
160 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
161 getBooleanSetting key = case lookup key mySettings of
162 Just "YES" -> return True
163 Just "NO" -> return False
164 Just xs -> pgmError ("Bad value for " ++ show key ++ ": " ++ show xs)
165 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
166 readSetting key = case lookup key mySettings of
167 Just xs ->
168 case maybeRead xs of
169 Just v -> return v
170 Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs)
171 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
172 crossCompiling <- getBooleanSetting "cross compiling"
173 targetArch <- readSetting "target arch"
174 targetOS <- readSetting "target os"
175 targetWordSize <- readSetting "target word size"
176 targetUnregisterised <- getBooleanSetting "Unregisterised"
177 targetHasGnuNonexecStack <- readSetting "target has GNU nonexec stack"
178 targetHasIdentDirective <- readSetting "target has .ident directive"
179 targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols"
180 myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
181 -- On Windows, mingw is distributed with GHC,
182 -- so we look in TopDir/../mingw/bin
183 -- It would perhaps be nice to be able to override this
184 -- with the settings file, but it would be a little fiddly
185 -- to make that possible, so for now you can't.
186 gcc_prog <- getSetting "C compiler command"
187 gcc_args_str <- getSetting "C compiler flags"
188 gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
189 cpp_prog <- getSetting "Haskell CPP command"
190 cpp_args_str <- getSetting "Haskell CPP flags"
191 let unreg_gcc_args = if targetUnregisterised
192 then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
193 else []
194 -- TABLES_NEXT_TO_CODE affects the info table layout.
195 tntc_gcc_args
196 | mkTablesNextToCode targetUnregisterised
197 = ["-DTABLES_NEXT_TO_CODE"]
198 | otherwise = []
199 cpp_args= map Option (words cpp_args_str)
200 gcc_args = map Option (words gcc_args_str
201 ++ unreg_gcc_args
202 ++ tntc_gcc_args)
203 ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
204 ldSupportsBuildId <- getBooleanSetting "ld supports build-id"
205 ldSupportsFilelist <- getBooleanSetting "ld supports filelist"
206 ldIsGnuLd <- getBooleanSetting "ld is GNU ld"
207 perl_path <- getSetting "perl command"
208
209 let pkgconfig_path = installed "package.conf.d"
210 ghc_usage_msg_path = installed "ghc-usage.txt"
211 ghci_usage_msg_path = installed "ghci-usage.txt"
212
213 -- For all systems, unlit, split, mangle are GHC utilities
214 -- architecture-specific stuff is done when building Config.hs
215 unlit_path = libexec cGHC_UNLIT_PGM
216
217 -- split is a Perl script
218 split_script = libexec cGHC_SPLIT_PGM
219
220 windres_path <- getSetting "windres command"
221 libtool_path <- getSetting "libtool command"
222 ar_path <- getSetting "ar command"
223 ranlib_path <- getSetting "ranlib command"
224
225 tmpdir <- getTemporaryDirectory
226
227 touch_path <- getSetting "touch command"
228
229 let -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
230 -- a call to Perl to get the invocation of split.
231 -- On Unix, scripts are invoked using the '#!' method. Binary
232 -- installations of GHC on Unix place the correct line on the
233 -- front of the script at installation time, so we don't want
234 -- to wire-in our knowledge of $(PERL) on the host system here.
235 (split_prog, split_args)
236 | isWindowsHost = (perl_path, [Option split_script])
237 | otherwise = (split_script, [])
238 mkdll_prog <- getSetting "dllwrap command"
239 let mkdll_args = []
240
241 -- cpp is derived from gcc on all platforms
242 -- HACK, see setPgmP below. We keep 'words' here to remember to fix
243 -- Config.hs one day.
244
245
246 -- Other things being equal, as and ld are simply gcc
247 gcc_link_args_str <- getSetting "C compiler link flags"
248 let as_prog = gcc_prog
249 as_args = gcc_args
250 ld_prog = gcc_prog
251 ld_args = gcc_args ++ map Option (words gcc_link_args_str)
252
253 -- We just assume on command line
254 lc_prog <- getSetting "LLVM llc command"
255 lo_prog <- getSetting "LLVM opt command"
256 lcc_prog <- getSetting "LLVM clang command"
257
258 let iserv_prog = libexec "ghc-iserv"
259
260 let platform = Platform {
261 platformArch = targetArch,
262 platformOS = targetOS,
263 platformWordSize = targetWordSize,
264 platformUnregisterised = targetUnregisterised,
265 platformHasGnuNonexecStack = targetHasGnuNonexecStack,
266 platformHasIdentDirective = targetHasIdentDirective,
267 platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols,
268 platformIsCrossCompiling = crossCompiling
269 }
270
271 return $ Settings {
272 sTargetPlatform = platform,
273 sTmpDir = normalise tmpdir,
274 sGhcUsagePath = ghc_usage_msg_path,
275 sGhciUsagePath = ghci_usage_msg_path,
276 sTopDir = top_dir,
277 sRawSettings = mySettings,
278 sExtraGccViaCFlags = words myExtraGccViaCFlags,
279 sSystemPackageConfig = pkgconfig_path,
280 sLdSupportsCompactUnwind = ldSupportsCompactUnwind,
281 sLdSupportsBuildId = ldSupportsBuildId,
282 sLdSupportsFilelist = ldSupportsFilelist,
283 sLdIsGnuLd = ldIsGnuLd,
284 sGccSupportsNoPie = gccSupportsNoPie,
285 sProgramName = "ghc",
286 sProjectVersion = cProjectVersion,
287 sPgm_L = unlit_path,
288 sPgm_P = (cpp_prog, cpp_args),
289 sPgm_F = "",
290 sPgm_c = (gcc_prog, gcc_args),
291 sPgm_s = (split_prog,split_args),
292 sPgm_a = (as_prog, as_args),
293 sPgm_l = (ld_prog, ld_args),
294 sPgm_dll = (mkdll_prog,mkdll_args),
295 sPgm_T = touch_path,
296 sPgm_windres = windres_path,
297 sPgm_libtool = libtool_path,
298 sPgm_ar = ar_path,
299 sPgm_ranlib = ranlib_path,
300 sPgm_lo = (lo_prog,[]),
301 sPgm_lc = (lc_prog,[]),
302 sPgm_lcc = (lcc_prog,[]),
303 sPgm_i = iserv_prog,
304 sOpt_L = [],
305 sOpt_P = [],
306 sOpt_P_fingerprint = fingerprint0,
307 sOpt_F = [],
308 sOpt_c = [],
309 sOpt_a = [],
310 sOpt_l = [],
311 sOpt_windres = [],
312 sOpt_lcc = [],
313 sOpt_lo = [],
314 sOpt_lc = [],
315 sOpt_i = [],
316 sPlatformConstants = platformConstants
317 }
318
319
320 {- Note [Windows stack usage]
321
322 See: Trac #8870 (and #8834 for related info) and #12186
323
324 On Windows, occasionally we need to grow the stack. In order to do
325 this, we would normally just bump the stack pointer - but there's a
326 catch on Windows.
327
328 If the stack pointer is bumped by more than a single page, then the
329 pages between the initial pointer and the resulting location must be
330 properly committed by the Windows virtual memory subsystem. This is
331 only needed in the event we bump by more than one page (i.e 4097 bytes
332 or more).
333
334 Windows compilers solve this by emitting a call to a special function
335 called _chkstk, which does this committing of the pages for you.
336
337 The reason this was causing a segfault was because due to the fact the
338 new code generator tends to generate larger functions, we needed more
339 stack space in GHC itself. In the x86 codegen, we needed approximately
340 ~12kb of stack space in one go, which caused the process to segfault,
341 as the intervening pages were not committed.
342
343 GCC can emit such a check for us automatically but only when the flag
344 -fstack-check is used.
345
346 See https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html
347 for more information.
348
349 -}
350
351 copy :: DynFlags -> String -> FilePath -> FilePath -> IO ()
352 copy dflags purpose from to = copyWithHeader dflags purpose Nothing from to
353
354 copyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath
355 -> IO ()
356 copyWithHeader dflags purpose maybe_header from to = do
357 showPass dflags purpose
358
359 hout <- openBinaryFile to WriteMode
360 hin <- openBinaryFile from ReadMode
361 ls <- hGetContents hin -- inefficient, but it'll do for now. ToDo: speed up
362 maybe (return ()) (header hout) maybe_header
363 hPutStr hout ls
364 hClose hout
365 hClose hin
366 where
367 -- write the header string in UTF-8. The header is something like
368 -- {-# LINE "foo.hs" #-}
369 -- and we want to make sure a Unicode filename isn't mangled.
370 header h str = do
371 hSetEncoding h utf8
372 hPutStr h str
373 hSetBinaryMode h True
374
375 {-
376 ************************************************************************
377 * *
378 \subsection{Support code}
379 * *
380 ************************************************************************
381 -}
382
383 linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
384 linkDynLib dflags0 o_files dep_packages
385 = do
386 let -- This is a rather ugly hack to fix dynamically linked
387 -- GHC on Windows. If GHC is linked with -threaded, then
388 -- it links against libHSrts_thr. But if base is linked
389 -- against libHSrts, then both end up getting loaded,
390 -- and things go wrong. We therefore link the libraries
391 -- with the same RTS flags that we link GHC with.
392 dflags1 = if cGhcThreaded then addWay' WayThreaded dflags0
393 else dflags0
394 dflags2 = if cGhcDebugged then addWay' WayDebug dflags1
395 else dflags1
396 dflags = updateWays dflags2
397
398 verbFlags = getVerbFlags dflags
399 o_file = outputFile dflags
400
401 pkgs <- getPreloadPackagesAnd dflags dep_packages
402
403 let pkg_lib_paths = collectLibraryPaths dflags pkgs
404 let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
405 get_pkg_lib_path_opts l
406 | ( osElfTarget (platformOS (targetPlatform dflags)) ||
407 osMachOTarget (platformOS (targetPlatform dflags)) ) &&
408 dynLibLoader dflags == SystemDependent &&
409 WayDyn `elem` ways dflags
410 = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
411 -- See Note [-Xlinker -rpath vs -Wl,-rpath]
412 | otherwise = ["-L" ++ l]
413
414 let lib_paths = libraryPaths dflags
415 let lib_path_opts = map ("-L"++) lib_paths
416
417 -- We don't want to link our dynamic libs against the RTS package,
418 -- because the RTS lib comes in several flavours and we want to be
419 -- able to pick the flavour when a binary is linked.
420 -- On Windows we need to link the RTS import lib as Windows does
421 -- not allow undefined symbols.
422 -- The RTS library path is still added to the library search path
423 -- above in case the RTS is being explicitly linked in (see #3807).
424 let platform = targetPlatform dflags
425 os = platformOS platform
426 pkgs_no_rts = case os of
427 OSMinGW32 ->
428 pkgs
429 _ ->
430 filter ((/= rtsUnitId) . packageConfigId) pkgs
431 let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts
432 in package_hs_libs ++ extra_libs ++ other_flags
433
434 -- probably _stub.o files
435 -- and last temporary shared object file
436 let extra_ld_inputs = ldInputs dflags
437
438 -- frameworks
439 pkg_framework_opts <- getPkgFrameworkOpts dflags platform
440 (map unitId pkgs)
441 let framework_opts = getFrameworkOpts dflags platform
442
443 case os of
444 OSMinGW32 -> do
445 -------------------------------------------------------------
446 -- Making a DLL
447 -------------------------------------------------------------
448 let output_fn = case o_file of
449 Just s -> s
450 Nothing -> "HSdll.dll"
451
452 runLink dflags (
453 map Option verbFlags
454 ++ [ Option "-o"
455 , FileOption "" output_fn
456 , Option "-shared"
457 ] ++
458 [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
459 | gopt Opt_SharedImplib dflags
460 ]
461 ++ map (FileOption "") o_files
462
463 -- Permit the linker to auto link _symbol to _imp_symbol
464 -- This lets us link against DLLs without needing an "import library"
465 ++ [Option "-Wl,--enable-auto-import"]
466
467 ++ extra_ld_inputs
468 ++ map Option (
469 lib_path_opts
470 ++ pkg_lib_path_opts
471 ++ pkg_link_opts
472 ))
473 _ | os == OSDarwin -> do
474 -------------------------------------------------------------------
475 -- Making a darwin dylib
476 -------------------------------------------------------------------
477 -- About the options used for Darwin:
478 -- -dynamiclib
479 -- Apple's way of saying -shared
480 -- -undefined dynamic_lookup:
481 -- Without these options, we'd have to specify the correct
482 -- dependencies for each of the dylibs. Note that we could
483 -- (and should) do without this for all libraries except
484 -- the RTS; all we need to do is to pass the correct
485 -- HSfoo_dyn.dylib files to the link command.
486 -- This feature requires Mac OS X 10.3 or later; there is
487 -- a similar feature, -flat_namespace -undefined suppress,
488 -- which works on earlier versions, but it has other
489 -- disadvantages.
490 -- -single_module
491 -- Build the dynamic library as a single "module", i.e. no
492 -- dynamic binding nonsense when referring to symbols from
493 -- within the library. The NCG assumes that this option is
494 -- specified (on i386, at least).
495 -- -install_name
496 -- Mac OS/X stores the path where a dynamic library is (to
497 -- be) installed in the library itself. It's called the
498 -- "install name" of the library. Then any library or
499 -- executable that links against it before it's installed
500 -- will search for it in its ultimate install location.
501 -- By default we set the install name to the absolute path
502 -- at build time, but it can be overridden by the
503 -- -dylib-install-name option passed to ghc. Cabal does
504 -- this.
505 -------------------------------------------------------------------
506
507 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
508
509 instName <- case dylibInstallName dflags of
510 Just n -> return n
511 Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
512 runLink dflags (
513 map Option verbFlags
514 ++ [ Option "-dynamiclib"
515 , Option "-o"
516 , FileOption "" output_fn
517 ]
518 ++ map Option o_files
519 ++ [ Option "-undefined",
520 Option "dynamic_lookup",
521 Option "-single_module" ]
522 ++ (if platformArch platform == ArchX86_64
523 then [ ]
524 else [ Option "-Wl,-read_only_relocs,suppress" ])
525 ++ [ Option "-install_name", Option instName ]
526 ++ map Option lib_path_opts
527 ++ extra_ld_inputs
528 ++ map Option framework_opts
529 ++ map Option pkg_lib_path_opts
530 ++ map Option pkg_link_opts
531 ++ map Option pkg_framework_opts
532 )
533 _ -> do
534 -------------------------------------------------------------------
535 -- Making a DSO
536 -------------------------------------------------------------------
537
538 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
539 let bsymbolicFlag = -- we need symbolic linking to resolve
540 -- non-PIC intra-package-relocations
541 ["-Wl,-Bsymbolic"]
542
543 runLink dflags (
544 map Option verbFlags
545 ++ libmLinkOpts
546 ++ [ Option "-o"
547 , FileOption "" output_fn
548 ]
549 ++ map Option o_files
550 ++ [ Option "-shared" ]
551 ++ map Option bsymbolicFlag
552 -- Set the library soname. We use -h rather than -soname as
553 -- Solaris 10 doesn't support the latter:
554 ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
555 ++ extra_ld_inputs
556 ++ map Option lib_path_opts
557 ++ map Option pkg_lib_path_opts
558 ++ map Option pkg_link_opts
559 )
560
561 -- | Some platforms require that we explicitly link against @libm@ if any
562 -- math-y things are used (which we assume to include all programs). See #14022.
563 libmLinkOpts :: [Option]
564 libmLinkOpts =
565 #if defined(HAVE_LIBM)
566 [Option "-lm"]
567 #else
568 []
569 #endif
570
571 getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
572 getPkgFrameworkOpts dflags platform dep_packages
573 | platformUsesFrameworks platform = do
574 pkg_framework_path_opts <- do
575 pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
576 return $ map ("-F" ++) pkg_framework_paths
577
578 pkg_framework_opts <- do
579 pkg_frameworks <- getPackageFrameworks dflags dep_packages
580 return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
581
582 return (pkg_framework_path_opts ++ pkg_framework_opts)
583
584 | otherwise = return []
585
586 getFrameworkOpts :: DynFlags -> Platform -> [String]
587 getFrameworkOpts dflags platform
588 | platformUsesFrameworks platform = framework_path_opts ++ framework_opts
589 | otherwise = []
590 where
591 framework_paths = frameworkPaths dflags
592 framework_path_opts = map ("-F" ++) framework_paths
593
594 frameworks = cmdlineFrameworks dflags
595 -- reverse because they're added in reverse order from the cmd line:
596 framework_opts = concat [ ["-framework", fw]
597 | fw <- reverse frameworks ]