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