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