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