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