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