Relocatable GHC
[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 Option(..),
28
29 -- platform-specifics
30 libmLinkOpts,
31
32 -- frameworks
33 getPkgFrameworkOpts,
34 getFrameworkOpts
35 ) where
36
37 #include "HsVersions.h"
38
39 import GhcPrelude
40
41 import Module
42 import Packages
43 import Config
44 import Outputable
45 import ErrUtils
46 import Panic
47 import Platform
48 import Util
49 import DynFlags
50
51 import System.Environment (getExecutablePath)
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 Data.List
59
60 #if defined(mingw32_HOST_OS)
61 #if MIN_VERSION_Win32(2,5,0)
62 import qualified System.Win32.Types as Win32
63 #else
64 import qualified System.Win32.Info as Win32
65 #endif
66 import Data.Char
67 import Exception
68 import Foreign
69 import Foreign.C.String
70 import System.Win32.Types (DWORD, LPTSTR, HANDLE)
71 import System.Win32.Types (failIfNull, failIf, iNVALID_HANDLE_VALUE)
72 import System.Win32.File (createFile,closeHandle, gENERIC_READ, fILE_SHARE_READ, oPEN_EXISTING, fILE_ATTRIBUTE_NORMAL, fILE_FLAG_BACKUP_SEMANTICS )
73 import System.Win32.DLL (loadLibrary, getProcAddress)
74 #endif
75
76 #if defined(mingw32_HOST_OS)
77 # if defined(i386_HOST_ARCH)
78 # define WINDOWS_CCONV stdcall
79 # elif defined(x86_64_HOST_ARCH)
80 # define WINDOWS_CCONV ccall
81 # else
82 # error Unknown mingw32 arch
83 # endif
84 #endif
85
86 {-
87 How GHC finds its files
88 ~~~~~~~~~~~~~~~~~~~~~~~
89
90 [Note topdir]
91
92 GHC needs various support files (library packages, RTS etc), plus
93 various auxiliary programs (cp, gcc, etc). It starts by finding topdir,
94 the root of GHC's support files
95
96 On Unix:
97 - ghc always has a shell wrapper that passes a -B<dir> option
98
99 On Windows:
100 - ghc never has a shell wrapper.
101 - we can find the location of the ghc binary, which is
102 $topdir/<foo>/<something>.exe
103 where <something> may be "ghc", "ghc-stage2", or similar
104 - we strip off the "<foo>/<something>.exe" to leave $topdir.
105
106 from topdir we can find package.conf, ghc-asm, etc.
107
108
109 SysTools.initSysProgs figures out exactly where all the auxiliary programs
110 are, and initialises mutable variables to make it easy to call them.
111 To to this, it makes use of definitions in Config.hs, which is a Haskell
112 file containing variables whose value is figured out by the build system.
113
114 Config.hs contains two sorts of things
115
116 cGCC, The *names* of the programs
117 cCPP e.g. cGCC = gcc
118 cUNLIT cCPP = gcc -E
119 etc They do *not* include paths
120
121
122 cUNLIT_DIR The *path* to the directory containing unlit, split etc
123 cSPLIT_DIR *relative* to the root of the build tree,
124 for use when running *in-place* in a build tree (only)
125
126
127
128 ---------------------------------------------
129 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
130
131 Another hair-brained scheme for simplifying the current tool location
132 nightmare in GHC: Simon originally suggested using another
133 configuration file along the lines of GCC's specs file - which is fine
134 except that it means adding code to read yet another configuration
135 file. What I didn't notice is that the current package.conf is
136 general enough to do this:
137
138 Package
139 {name = "tools", import_dirs = [], source_dirs = [],
140 library_dirs = [], hs_libraries = [], extra_libraries = [],
141 include_dirs = [], c_includes = [], package_deps = [],
142 extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${topdir}/bin/unlit", ... etc.],
143 extra_cc_opts = [], extra_ld_opts = []}
144
145 Which would have the advantage that we get to collect together in one
146 place the path-specific package stuff with the path-specific tool
147 stuff.
148 End of NOTES
149 ---------------------------------------------
150
151 ************************************************************************
152 * *
153 \subsection{Initialisation}
154 * *
155 ************************************************************************
156 -}
157
158 initLlvmTargets :: Maybe String
159 -> IO LlvmTargets
160 initLlvmTargets mbMinusB
161 = do top_dir <- findTopDir mbMinusB
162 let llvmTargetsFile = top_dir </> "llvm-targets"
163 llvmTargetsStr <- readFile llvmTargetsFile
164 case maybeReadFuzzy llvmTargetsStr of
165 Just s -> return (fmap mkLlvmTarget <$> s)
166 Nothing -> pgmError ("Can't parse " ++ show llvmTargetsFile)
167 where
168 mkLlvmTarget :: (String, String, String) -> LlvmTarget
169 mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)
170
171
172 initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix)
173 -> IO Settings -- Set all the mutable variables above, holding
174 -- (a) the system programs
175 -- (b) the package-config file
176 -- (c) the GHC usage message
177 initSysTools mbMinusB
178 = do top_dir <- findTopDir mbMinusB
179 -- see [Note topdir]
180 -- NB: top_dir is assumed to be in standard Unix
181 -- format, '/' separated
182
183 let settingsFile = top_dir </> "settings"
184 platformConstantsFile = top_dir </> "platformConstants"
185 installed :: FilePath -> FilePath
186 installed file = top_dir </> file
187 libexec :: FilePath -> FilePath
188 libexec file = top_dir </> "bin" </> file
189
190 settingsStr <- readFile settingsFile
191 platformConstantsStr <- readFile platformConstantsFile
192 mySettings <- case maybeReadFuzzy settingsStr of
193 Just s ->
194 return s
195 Nothing ->
196 pgmError ("Can't parse " ++ show settingsFile)
197 platformConstants <- case maybeReadFuzzy platformConstantsStr of
198 Just s ->
199 return s
200 Nothing ->
201 pgmError ("Can't parse " ++
202 show platformConstantsFile)
203 let getSetting key = case lookup key mySettings of
204 Just xs ->
205 return $ case stripPrefix "$topdir" xs of
206 Just [] ->
207 top_dir
208 Just xs'@(c:_)
209 | isPathSeparator c ->
210 top_dir ++ xs'
211 _ ->
212 xs
213 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
214 getBooleanSetting key = case lookup key mySettings of
215 Just "YES" -> return True
216 Just "NO" -> return False
217 Just xs -> pgmError ("Bad value for " ++ show key ++ ": " ++ show xs)
218 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
219 readSetting key = case lookup key mySettings of
220 Just xs ->
221 case maybeRead xs of
222 Just v -> return v
223 Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs)
224 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
225 crossCompiling <- getBooleanSetting "cross compiling"
226 targetArch <- readSetting "target arch"
227 targetOS <- readSetting "target os"
228 targetWordSize <- readSetting "target word size"
229 targetUnregisterised <- getBooleanSetting "Unregisterised"
230 targetHasGnuNonexecStack <- readSetting "target has GNU nonexec stack"
231 targetHasIdentDirective <- readSetting "target has .ident directive"
232 targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols"
233 myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
234 -- On Windows, mingw is distributed with GHC,
235 -- so we look in TopDir/../mingw/bin
236 -- It would perhaps be nice to be able to override this
237 -- with the settings file, but it would be a little fiddly
238 -- to make that possible, so for now you can't.
239 gcc_prog <- getSetting "C compiler command"
240 gcc_args_str <- getSetting "C compiler flags"
241 gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
242 cpp_prog <- getSetting "Haskell CPP command"
243 cpp_args_str <- getSetting "Haskell CPP flags"
244 let unreg_gcc_args = if targetUnregisterised
245 then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
246 else []
247 -- TABLES_NEXT_TO_CODE affects the info table layout.
248 tntc_gcc_args
249 | mkTablesNextToCode targetUnregisterised
250 = ["-DTABLES_NEXT_TO_CODE"]
251 | otherwise = []
252 cpp_args= map Option (words cpp_args_str)
253 gcc_args = map Option (words gcc_args_str
254 ++ unreg_gcc_args
255 ++ tntc_gcc_args)
256 ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
257 ldSupportsBuildId <- getBooleanSetting "ld supports build-id"
258 ldSupportsFilelist <- getBooleanSetting "ld supports filelist"
259 ldIsGnuLd <- getBooleanSetting "ld is GNU ld"
260 perl_path <- getSetting "perl command"
261
262 let pkgconfig_path = installed "package.conf.d"
263 ghc_usage_msg_path = installed "ghc-usage.txt"
264 ghci_usage_msg_path = installed "ghci-usage.txt"
265
266 -- For all systems, unlit, split, mangle are GHC utilities
267 -- architecture-specific stuff is done when building Config.hs
268 unlit_path = libexec cGHC_UNLIT_PGM
269
270 -- split is a Perl script
271 split_script = libexec cGHC_SPLIT_PGM
272
273 windres_path <- getSetting "windres command"
274 libtool_path <- getSetting "libtool command"
275 ar_path <- getSetting "ar command"
276 ranlib_path <- getSetting "ranlib command"
277
278 tmpdir <- getTemporaryDirectory
279
280 touch_path <- getSetting "touch command"
281
282 let -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
283 -- a call to Perl to get the invocation of split.
284 -- On Unix, scripts are invoked using the '#!' method. Binary
285 -- installations of GHC on Unix place the correct line on the
286 -- front of the script at installation time, so we don't want
287 -- to wire-in our knowledge of $(PERL) on the host system here.
288 (split_prog, split_args)
289 | isWindowsHost = (perl_path, [Option split_script])
290 | otherwise = (split_script, [])
291 mkdll_prog <- getSetting "dllwrap command"
292 let mkdll_args = []
293
294 -- cpp is derived from gcc on all platforms
295 -- HACK, see setPgmP below. We keep 'words' here to remember to fix
296 -- Config.hs one day.
297
298
299 -- Other things being equal, as and ld are simply gcc
300 gcc_link_args_str <- getSetting "C compiler link flags"
301 let as_prog = gcc_prog
302 as_args = gcc_args
303 ld_prog = gcc_prog
304 ld_args = gcc_args ++ map Option (words gcc_link_args_str)
305
306 -- We just assume on command line
307 lc_prog <- getSetting "LLVM llc command"
308 lo_prog <- getSetting "LLVM opt command"
309 lcc_prog <- getSetting "LLVM clang command"
310
311 let iserv_prog = libexec "ghc-iserv"
312
313 let platform = Platform {
314 platformArch = targetArch,
315 platformOS = targetOS,
316 platformWordSize = targetWordSize,
317 platformUnregisterised = targetUnregisterised,
318 platformHasGnuNonexecStack = targetHasGnuNonexecStack,
319 platformHasIdentDirective = targetHasIdentDirective,
320 platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols,
321 platformIsCrossCompiling = crossCompiling
322 }
323
324 return $ Settings {
325 sTargetPlatform = platform,
326 sTmpDir = normalise tmpdir,
327 sGhcUsagePath = ghc_usage_msg_path,
328 sGhciUsagePath = ghci_usage_msg_path,
329 sTopDir = top_dir,
330 sRawSettings = mySettings,
331 sExtraGccViaCFlags = words myExtraGccViaCFlags,
332 sSystemPackageConfig = pkgconfig_path,
333 sLdSupportsCompactUnwind = ldSupportsCompactUnwind,
334 sLdSupportsBuildId = ldSupportsBuildId,
335 sLdSupportsFilelist = ldSupportsFilelist,
336 sLdIsGnuLd = ldIsGnuLd,
337 sGccSupportsNoPie = gccSupportsNoPie,
338 sProgramName = "ghc",
339 sProjectVersion = cProjectVersion,
340 sPgm_L = unlit_path,
341 sPgm_P = (cpp_prog, cpp_args),
342 sPgm_F = "",
343 sPgm_c = (gcc_prog, gcc_args),
344 sPgm_s = (split_prog,split_args),
345 sPgm_a = (as_prog, as_args),
346 sPgm_l = (ld_prog, ld_args),
347 sPgm_dll = (mkdll_prog,mkdll_args),
348 sPgm_T = touch_path,
349 sPgm_windres = windres_path,
350 sPgm_libtool = libtool_path,
351 sPgm_ar = ar_path,
352 sPgm_ranlib = ranlib_path,
353 sPgm_lo = (lo_prog,[]),
354 sPgm_lc = (lc_prog,[]),
355 sPgm_lcc = (lcc_prog,[]),
356 sPgm_i = iserv_prog,
357 sOpt_L = [],
358 sOpt_P = [],
359 sOpt_F = [],
360 sOpt_c = [],
361 sOpt_a = [],
362 sOpt_l = [],
363 sOpt_windres = [],
364 sOpt_lcc = [],
365 sOpt_lo = [],
366 sOpt_lc = [],
367 sOpt_i = [],
368 sPlatformConstants = platformConstants
369 }
370
371 -- returns a Unix-format path (relying on getBaseDir to do so too)
372 findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
373 -> IO String -- TopDir (in Unix format '/' separated)
374 findTopDir (Just minusb) = return (normalise minusb)
375 findTopDir Nothing
376 = do -- Get directory of executable
377 maybe_exec_dir <- getBaseDir
378 case maybe_exec_dir of
379 -- "Just" on Windows, "Nothing" on unix
380 Nothing -> throwGhcExceptionIO (InstallationError "missing -B<dir> option")
381 Just dir -> return dir
382
383 {- Note [Windows stack usage]
384
385 See: Trac #8870 (and #8834 for related info) and #12186
386
387 On Windows, occasionally we need to grow the stack. In order to do
388 this, we would normally just bump the stack pointer - but there's a
389 catch on Windows.
390
391 If the stack pointer is bumped by more than a single page, then the
392 pages between the initial pointer and the resulting location must be
393 properly committed by the Windows virtual memory subsystem. This is
394 only needed in the event we bump by more than one page (i.e 4097 bytes
395 or more).
396
397 Windows compilers solve this by emitting a call to a special function
398 called _chkstk, which does this committing of the pages for you.
399
400 The reason this was causing a segfault was because due to the fact the
401 new code generator tends to generate larger functions, we needed more
402 stack space in GHC itself. In the x86 codegen, we needed approximately
403 ~12kb of stack space in one go, which caused the process to segfault,
404 as the intervening pages were not committed.
405
406 GCC can emit such a check for us automatically but only when the flag
407 -fstack-check is used.
408
409 See https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html
410 for more information.
411
412 -}
413
414 copy :: DynFlags -> String -> FilePath -> FilePath -> IO ()
415 copy dflags purpose from to = copyWithHeader dflags purpose Nothing from to
416
417 copyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath
418 -> IO ()
419 copyWithHeader dflags purpose maybe_header from to = do
420 showPass dflags purpose
421
422 hout <- openBinaryFile to WriteMode
423 hin <- openBinaryFile from ReadMode
424 ls <- hGetContents hin -- inefficient, but it'll do for now. ToDo: speed up
425 maybe (return ()) (header hout) maybe_header
426 hPutStr hout ls
427 hClose hout
428 hClose hin
429 where
430 -- write the header string in UTF-8. The header is something like
431 -- {-# LINE "foo.hs" #-}
432 -- and we want to make sure a Unicode filename isn't mangled.
433 header h str = do
434 hSetEncoding h utf8
435 hPutStr h str
436 hSetBinaryMode h True
437
438 {-
439 ************************************************************************
440 * *
441 \subsection{Support code}
442 * *
443 ************************************************************************
444 -}
445
446 -----------------------------------------------------------------------------
447 -- Define getBaseDir :: IO (Maybe String)
448
449 getBaseDir :: IO (Maybe String)
450 #if defined(mingw32_HOST_OS)
451 -- Assuming we are running ghc, accessed by path $(stuff)/<foo>/ghc.exe,
452 -- return the path $(stuff)/lib.
453 getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
454 where
455 try_size size = allocaArray (fromIntegral size) $ \buf -> do
456 ret <- c_GetModuleFileName nullPtr buf size
457 case ret of
458 0 -> return Nothing
459 _ | ret < size -> do
460 path <- peekCWString buf
461 real <- getFinalPath path -- try to resolve symlinks paths
462 let libdir = (rootDir . sanitize . maybe path id) real
463 exists <- doesDirectoryExist libdir
464 if exists
465 then return $ Just libdir
466 else fail path
467 | otherwise -> try_size (size * 2)
468
469 -- getFinalPath returns paths in full raw form.
470 -- Unfortunately GHC isn't set up to handle these
471 -- So if the call succeeded, we need to drop the
472 -- \\?\ prefix.
473 sanitize s = if "\\\\?\\" `isPrefixOf` s
474 then drop 4 s
475 else s
476
477 rootDir s = case splitFileName $ normalise s of
478 (d, ghc_exe)
479 | lower ghc_exe `elem` ["ghc.exe",
480 "ghc-stage1.exe",
481 "ghc-stage2.exe",
482 "ghc-stage3.exe"] ->
483 case splitFileName $ takeDirectory d of
484 -- ghc is in $topdir/bin/ghc.exe
485 (d', _) -> takeDirectory d' </> "lib"
486 _ -> fail s
487
488 fail s = panic ("can't decompose ghc.exe path: " ++ show s)
489 lower = map toLower
490
491 foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
492 c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
493
494 -- Attempt to resolve symlinks in order to find the actual location GHC
495 -- is located at. See Trac #11759.
496 getFinalPath :: FilePath -> IO (Maybe FilePath)
497 getFinalPath name = do
498 dllHwnd <- failIfNull "LoadLibrary" $ loadLibrary "kernel32.dll"
499 -- Note: The API GetFinalPathNameByHandleW is only available starting from Windows Vista.
500 -- This means that we can't bind directly to it since it may be missing.
501 -- Instead try to find it's address at runtime and if we don't succeed consider the
502 -- function failed.
503 addr_m <- (fmap Just $ failIfNull "getProcAddress" $ getProcAddress dllHwnd "GetFinalPathNameByHandleW")
504 `catch` (\(_ :: SomeException) -> return Nothing)
505 case addr_m of
506 Nothing -> return Nothing
507 Just addr -> do handle <- failIf (==iNVALID_HANDLE_VALUE) "CreateFile"
508 $ createFile name
509 gENERIC_READ
510 fILE_SHARE_READ
511 Nothing
512 oPEN_EXISTING
513 (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS)
514 Nothing
515 let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr
516 -- First try to resolve the path to get the actual path
517 -- of any symlinks or other file system redirections that
518 -- may be in place. However this function can fail, and in
519 -- the event it does fail, we need to try using the
520 -- original path and see if we can decompose that.
521 -- If the call fails Win32.try will raise an exception
522 -- that needs to be caught. See #14159
523 path <- (Win32.try "GetFinalPathName"
524 (\buf len -> fnPtr handle buf len 0) 512
525 `finally` closeHandle handle)
526 `catch`
527 (\(_ :: IOException) -> return name)
528 return $ Just path
529
530 type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD
531
532 foreign import WINDOWS_CCONV unsafe "dynamic"
533 makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath
534 #elif defined(darwin_HOST_OS) || defined(linux_HOST_OS)
535 -- on unix, this is a bit more confusing.
536 -- The layout right now is somehting like
537 --
538 -- /bin/ghc-X.Y.Z <- wrapper script (1)
539 -- /bin/ghc <- symlink to wrapper script (2)
540 -- /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)
541 -- /lib/ghc-X.Y.Z <- $topdir (4)
542 --
543 -- As such, we first need to find the absolute location to the
544 -- binary.
545 --
546 -- getExecutablePath will return (3). One takeDirectory will
547 -- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
548 --
549 -- This of course only works due to the current layout. If
550 -- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
551 -- this would need to be changed accordingly.
552 --
553 getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
554 #else
555 getBaseDir = return Nothing
556 #endif
557
558 linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
559 linkDynLib dflags0 o_files dep_packages
560 = do
561 let -- This is a rather ugly hack to fix dynamically linked
562 -- GHC on Windows. If GHC is linked with -threaded, then
563 -- it links against libHSrts_thr. But if base is linked
564 -- against libHSrts, then both end up getting loaded,
565 -- and things go wrong. We therefore link the libraries
566 -- with the same RTS flags that we link GHC with.
567 dflags1 = if cGhcThreaded then addWay' WayThreaded dflags0
568 else dflags0
569 dflags2 = if cGhcDebugged then addWay' WayDebug dflags1
570 else dflags1
571 dflags = updateWays dflags2
572
573 verbFlags = getVerbFlags dflags
574 o_file = outputFile dflags
575
576 pkgs <- getPreloadPackagesAnd dflags dep_packages
577
578 let pkg_lib_paths = collectLibraryPaths dflags pkgs
579 let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
580 get_pkg_lib_path_opts l
581 | ( osElfTarget (platformOS (targetPlatform dflags)) ||
582 osMachOTarget (platformOS (targetPlatform dflags)) ) &&
583 dynLibLoader dflags == SystemDependent &&
584 WayDyn `elem` ways dflags
585 = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
586 -- See Note [-Xlinker -rpath vs -Wl,-rpath]
587 | otherwise = ["-L" ++ l]
588
589 let lib_paths = libraryPaths dflags
590 let lib_path_opts = map ("-L"++) lib_paths
591
592 -- We don't want to link our dynamic libs against the RTS package,
593 -- because the RTS lib comes in several flavours and we want to be
594 -- able to pick the flavour when a binary is linked.
595 -- On Windows we need to link the RTS import lib as Windows does
596 -- not allow undefined symbols.
597 -- The RTS library path is still added to the library search path
598 -- above in case the RTS is being explicitly linked in (see #3807).
599 let platform = targetPlatform dflags
600 os = platformOS platform
601 pkgs_no_rts = case os of
602 OSMinGW32 ->
603 pkgs
604 _ ->
605 filter ((/= rtsUnitId) . packageConfigId) pkgs
606 let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts
607 in package_hs_libs ++ extra_libs ++ other_flags
608
609 -- probably _stub.o files
610 -- and last temporary shared object file
611 let extra_ld_inputs = ldInputs dflags
612
613 -- frameworks
614 pkg_framework_opts <- getPkgFrameworkOpts dflags platform
615 (map unitId pkgs)
616 let framework_opts = getFrameworkOpts dflags platform
617
618 case os of
619 OSMinGW32 -> do
620 -------------------------------------------------------------
621 -- Making a DLL
622 -------------------------------------------------------------
623 let output_fn = case o_file of
624 Just s -> s
625 Nothing -> "HSdll.dll"
626
627 runLink dflags (
628 map Option verbFlags
629 ++ [ Option "-o"
630 , FileOption "" output_fn
631 , Option "-shared"
632 ] ++
633 [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
634 | gopt Opt_SharedImplib dflags
635 ]
636 ++ map (FileOption "") o_files
637
638 -- Permit the linker to auto link _symbol to _imp_symbol
639 -- This lets us link against DLLs without needing an "import library"
640 ++ [Option "-Wl,--enable-auto-import"]
641
642 ++ extra_ld_inputs
643 ++ map Option (
644 lib_path_opts
645 ++ pkg_lib_path_opts
646 ++ pkg_link_opts
647 ))
648 _ | os == OSDarwin -> do
649 -------------------------------------------------------------------
650 -- Making a darwin dylib
651 -------------------------------------------------------------------
652 -- About the options used for Darwin:
653 -- -dynamiclib
654 -- Apple's way of saying -shared
655 -- -undefined dynamic_lookup:
656 -- Without these options, we'd have to specify the correct
657 -- dependencies for each of the dylibs. Note that we could
658 -- (and should) do without this for all libraries except
659 -- the RTS; all we need to do is to pass the correct
660 -- HSfoo_dyn.dylib files to the link command.
661 -- This feature requires Mac OS X 10.3 or later; there is
662 -- a similar feature, -flat_namespace -undefined suppress,
663 -- which works on earlier versions, but it has other
664 -- disadvantages.
665 -- -single_module
666 -- Build the dynamic library as a single "module", i.e. no
667 -- dynamic binding nonsense when referring to symbols from
668 -- within the library. The NCG assumes that this option is
669 -- specified (on i386, at least).
670 -- -install_name
671 -- Mac OS/X stores the path where a dynamic library is (to
672 -- be) installed in the library itself. It's called the
673 -- "install name" of the library. Then any library or
674 -- executable that links against it before it's installed
675 -- will search for it in its ultimate install location.
676 -- By default we set the install name to the absolute path
677 -- at build time, but it can be overridden by the
678 -- -dylib-install-name option passed to ghc. Cabal does
679 -- this.
680 -------------------------------------------------------------------
681
682 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
683
684 instName <- case dylibInstallName dflags of
685 Just n -> return n
686 Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
687 runLink dflags (
688 map Option verbFlags
689 ++ [ Option "-dynamiclib"
690 , Option "-o"
691 , FileOption "" output_fn
692 ]
693 ++ map Option o_files
694 ++ [ Option "-undefined",
695 Option "dynamic_lookup",
696 Option "-single_module" ]
697 ++ (if platformArch platform == ArchX86_64
698 then [ ]
699 else [ Option "-Wl,-read_only_relocs,suppress" ])
700 ++ [ Option "-install_name", Option instName ]
701 ++ map Option lib_path_opts
702 ++ extra_ld_inputs
703 ++ map Option framework_opts
704 ++ map Option pkg_lib_path_opts
705 ++ map Option pkg_link_opts
706 ++ map Option pkg_framework_opts
707 )
708 _ -> do
709 -------------------------------------------------------------------
710 -- Making a DSO
711 -------------------------------------------------------------------
712
713 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
714 let bsymbolicFlag = -- we need symbolic linking to resolve
715 -- non-PIC intra-package-relocations
716 ["-Wl,-Bsymbolic"]
717
718 runLink dflags (
719 map Option verbFlags
720 ++ libmLinkOpts
721 ++ [ Option "-o"
722 , FileOption "" output_fn
723 ]
724 ++ map Option o_files
725 ++ [ Option "-shared" ]
726 ++ map Option bsymbolicFlag
727 -- Set the library soname. We use -h rather than -soname as
728 -- Solaris 10 doesn't support the latter:
729 ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
730 ++ extra_ld_inputs
731 ++ map Option lib_path_opts
732 ++ map Option pkg_lib_path_opts
733 ++ map Option pkg_link_opts
734 )
735
736 -- | Some platforms require that we explicitly link against @libm@ if any
737 -- math-y things are used (which we assume to include all programs). See #14022.
738 libmLinkOpts :: [Option]
739 libmLinkOpts =
740 #if defined(HAVE_LIBM)
741 [Option "-lm"]
742 #else
743 []
744 #endif
745
746 getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
747 getPkgFrameworkOpts dflags platform dep_packages
748 | platformUsesFrameworks platform = do
749 pkg_framework_path_opts <- do
750 pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
751 return $ map ("-F" ++) pkg_framework_paths
752
753 pkg_framework_opts <- do
754 pkg_frameworks <- getPackageFrameworks dflags dep_packages
755 return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
756
757 return (pkg_framework_path_opts ++ pkg_framework_opts)
758
759 | otherwise = return []
760
761 getFrameworkOpts :: DynFlags -> Platform -> [String]
762 getFrameworkOpts dflags platform
763 | platformUsesFrameworks platform = framework_path_opts ++ framework_opts
764 | otherwise = []
765 where
766 framework_paths = frameworkPaths dflags
767 framework_path_opts = map ("-F" ++) framework_paths
768
769 frameworks = cmdlineFrameworks dflags
770 -- reverse because they're added in reverse order from the cmd line:
771 framework_opts = concat [ ["-framework", fw]
772 | fw <- reverse frameworks ]