never executed always true always false
1 module GHC.Linker.Static
2 ( linkBinary
3 , linkBinary'
4 , linkStaticLib
5 , exeFileName
6 )
7 where
8
9 import GHC.Prelude
10 import GHC.Platform
11 import GHC.Platform.Ways
12 import GHC.Settings
13
14 import GHC.SysTools
15 import GHC.SysTools.Ar
16
17 import GHC.Unit.Env
18 import GHC.Unit.Types
19 import GHC.Unit.Info
20 import GHC.Unit.State
21
22 import GHC.Utils.Logger
23 import GHC.Utils.Monad
24 import GHC.Utils.Misc
25 import GHC.Utils.TmpFs
26
27 import GHC.Linker.MacOS
28 import GHC.Linker.Unit
29 import GHC.Linker.Dynamic
30 import GHC.Linker.ExtraObj
31 import GHC.Linker.Windows
32
33 import GHC.Driver.Session
34
35 import System.FilePath
36 import System.Directory
37 import Control.Monad
38 import Data.Maybe
39
40 -----------------------------------------------------------------------------
41 -- Static linking, of .o files
42
43 -- The list of packages passed to link is the list of packages on
44 -- which this program depends, as discovered by the compilation
45 -- manager. It is combined with the list of packages that the user
46 -- specifies on the command line with -package flags.
47 --
48 -- In one-shot linking mode, we can't discover the package
49 -- dependencies (because we haven't actually done any compilation or
50 -- read any interface files), so the user must explicitly specify all
51 -- the packages.
52
53 {-
54 Note [-Xlinker -rpath vs -Wl,-rpath]
55 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56
57 -Wl takes a comma-separated list of options which in the case of
58 -Wl,-rpath -Wl,some,path,with,commas parses the path with commas
59 as separate options.
60 Buck, the build system, produces paths with commas in them.
61
62 -Xlinker doesn't have this disadvantage and as far as I can tell
63 it is supported by both gcc and clang. Anecdotally nvcc supports
64 -Xlinker, but not -Wl.
65 -}
66
67 linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
68 linkBinary = linkBinary' False
69
70 linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
71 linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
72 let platform = ue_platform unit_env
73 unit_state = ue_units unit_env
74 toolSettings' = toolSettings dflags
75 verbFlags = getVerbFlags dflags
76 output_fn = exeFileName platform staticLink (outputFile_ dflags)
77
78 -- get the full list of packages to link with, by combining the
79 -- explicit packages with the auto packages and all of their
80 -- dependencies, and eliminating duplicates.
81
82 full_output_fn <- if isAbsolute output_fn
83 then return output_fn
84 else do d <- getCurrentDirectory
85 return $ normalise (d </> output_fn)
86 pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
87 let pkg_lib_paths = collectLibraryDirs (ways dflags) pkgs
88 let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
89 get_pkg_lib_path_opts l
90 | osElfTarget (platformOS platform) &&
91 dynLibLoader dflags == SystemDependent &&
92 ways dflags `hasWay` WayDyn
93 = let libpath = if gopt Opt_RelativeDynlibPaths dflags
94 then "$ORIGIN" </>
95 (l `makeRelativeTo` full_output_fn)
96 else l
97 -- See Note [-Xlinker -rpath vs -Wl,-rpath]
98 rpath = if useXLinkerRPath dflags (platformOS platform)
99 then ["-Xlinker", "-rpath", "-Xlinker", libpath]
100 else []
101 -- Solaris 11's linker does not support -rpath-link option. It silently
102 -- ignores it and then complains about next option which is -l<some
103 -- dir> as being a directory and not expected object file, E.g
104 -- ld: elf error: file
105 -- /tmp/ghc-src/libraries/base/dist-install/build:
106 -- elf_begin: I/O error: region read: Is a directory
107 rpathlink = if (platformOS platform) == OSSolaris2
108 then []
109 else ["-Xlinker", "-rpath-link", "-Xlinker", l]
110 in ["-L" ++ l] ++ rpathlink ++ rpath
111 | osMachOTarget (platformOS platform) &&
112 dynLibLoader dflags == SystemDependent &&
113 ways dflags `hasWay` WayDyn &&
114 useXLinkerRPath dflags (platformOS platform)
115 = let libpath = if gopt Opt_RelativeDynlibPaths dflags
116 then "@loader_path" </>
117 (l `makeRelativeTo` full_output_fn)
118 else l
119 in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
120 | otherwise = ["-L" ++ l]
121
122 pkg_lib_path_opts <-
123 if gopt Opt_SingleLibFolder dflags
124 then do
125 libs <- getLibs dflags unit_env dep_units
126 tmpDir <- newTempDir logger tmpfs (tmpDir dflags)
127 sequence_ [ copyFile lib (tmpDir </> basename)
128 | (lib, basename) <- libs]
129 return [ "-L" ++ tmpDir ]
130 else pure pkg_lib_path_opts
131
132 let
133 dead_strip
134 | gopt Opt_WholeArchiveHsLibs dflags = []
135 | otherwise = if osSubsectionsViaSymbols (platformOS platform)
136 then ["-Wl,-dead_strip"]
137 else []
138 let lib_paths = libraryPaths dflags
139 let lib_path_opts = map ("-L"++) lib_paths
140
141 extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state
142 noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_units
143
144 let
145 (pre_hs_libs, post_hs_libs)
146 | gopt Opt_WholeArchiveHsLibs dflags
147 = if platformOS platform == OSDarwin
148 then (["-Wl,-all_load"], [])
149 -- OS X does not have a flag to turn off -all_load
150 else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"])
151 | otherwise
152 = ([],[])
153
154 pkg_link_opts <- do
155 (package_hs_libs, extra_libs, other_flags) <- getUnitLinkOpts dflags unit_env dep_units
156 return $ if staticLink
157 then package_hs_libs -- If building an executable really means making a static
158 -- library (e.g. iOS), then we only keep the -l options for
159 -- HS packages, because libtool doesn't accept other options.
160 -- In the case of iOS these need to be added by hand to the
161 -- final link in Xcode.
162 else other_flags ++ dead_strip
163 ++ pre_hs_libs ++ package_hs_libs ++ post_hs_libs
164 ++ extra_libs
165 -- -Wl,-u,<sym> contained in other_flags
166 -- needs to be put before -l<package>,
167 -- otherwise Solaris linker fails linking
168 -- a binary with unresolved symbols in RTS
169 -- which are defined in base package
170 -- the reason for this is a note in ld(1) about
171 -- '-u' option: "The placement of this option
172 -- on the command line is significant.
173 -- This option must be placed before the library
174 -- that defines the symbol."
175
176 -- frameworks
177 pkg_framework_opts <- getUnitFrameworkOpts unit_env dep_units
178 let framework_opts = getFrameworkOpts dflags platform
179
180 -- probably _stub.o files
181 let extra_ld_inputs = ldInputs dflags
182
183 rc_objs <- case platformOS platform of
184 OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger tmpfs dflags output_fn
185 _ -> return []
186
187 let link dflags args | staticLink = GHC.SysTools.runLibtool logger dflags args
188 | platformOS platform == OSDarwin
189 = do
190 GHC.SysTools.runLink logger tmpfs dflags args
191 GHC.Linker.MacOS.runInjectRPaths logger dflags pkg_lib_paths output_fn
192 | otherwise
193 = GHC.SysTools.runLink logger tmpfs dflags args
194
195 link dflags (
196 map GHC.SysTools.Option verbFlags
197 ++ [ GHC.SysTools.Option "-o"
198 , GHC.SysTools.FileOption "" output_fn
199 ]
200 ++ libmLinkOpts platform
201 ++ map GHC.SysTools.Option (
202 []
203
204 -- See Note [No PIE when linking]
205 ++ picCCOpts dflags
206
207 -- Permit the linker to auto link _symbol to _imp_symbol.
208 -- This lets us link against DLLs without needing an "import library".
209 ++ (if platformOS platform == OSMinGW32
210 then ["-Wl,--enable-auto-import"]
211 else [])
212
213 -- '-no_compact_unwind'
214 -- C++/Objective-C exceptions cannot use optimised
215 -- stack unwinding code. The optimised form is the
216 -- default in Xcode 4 on at least x86_64, and
217 -- without this flag we're also seeing warnings
218 -- like
219 -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
220 -- on x86.
221 ++ (if toolSettings_ldSupportsCompactUnwind toolSettings' &&
222 not staticLink &&
223 (platformOS platform == OSDarwin) &&
224 case platformArch platform of
225 ArchX86 -> True
226 ArchX86_64 -> True
227 ArchARM {} -> True
228 ArchAArch64 -> True
229 _ -> False
230 then ["-Wl,-no_compact_unwind"]
231 else [])
232
233 -- '-Wl,-read_only_relocs,suppress'
234 -- ld gives loads of warnings like:
235 -- ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure
236 -- when linking any program. We're not sure
237 -- whether this is something we ought to fix, but
238 -- for now this flags silences them.
239 ++ (if platformOS platform == OSDarwin &&
240 platformArch platform == ArchX86 &&
241 not staticLink
242 then ["-Wl,-read_only_relocs,suppress"]
243 else [])
244
245 ++ (if toolSettings_ldIsGnuLd toolSettings' &&
246 not (gopt Opt_WholeArchiveHsLibs dflags)
247 then ["-Wl,--gc-sections"]
248 else [])
249
250 ++ o_files
251 ++ lib_path_opts)
252 ++ extra_ld_inputs
253 ++ map GHC.SysTools.Option (
254 rc_objs
255 ++ framework_opts
256 ++ pkg_lib_path_opts
257 ++ extraLinkObj
258 ++ noteLinkObjs
259 ++ pkg_link_opts
260 ++ pkg_framework_opts
261 ++ (if platformOS platform == OSDarwin
262 -- dead_strip_dylibs, will remove unused dylibs, and thus save
263 -- space in the load commands. The -headerpad is necessary so
264 -- that we can inject more @rpath's later for the left over
265 -- libraries during runInjectRpaths phase.
266 --
267 -- See Note [Dynamic linking on macOS].
268 then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ]
269 else [])
270 ))
271
272 -- | Linking a static lib will not really link anything. It will merely produce
273 -- a static archive of all dependent static libraries. The resulting library
274 -- will still need to be linked with any remaining link flags.
275 linkStaticLib :: Logger -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
276 linkStaticLib logger dflags unit_env o_files dep_units = do
277 let platform = ue_platform unit_env
278 extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
279 modules = o_files ++ extra_ld_inputs
280 output_fn = exeFileName platform True (outputFile_ dflags)
281
282 full_output_fn <- if isAbsolute output_fn
283 then return output_fn
284 else do d <- getCurrentDirectory
285 return $ normalise (d </> output_fn)
286 output_exists <- doesFileExist full_output_fn
287 (when output_exists) $ removeFile full_output_fn
288
289 pkg_cfgs_init <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
290
291 let pkg_cfgs
292 | gopt Opt_LinkRts dflags
293 = pkg_cfgs_init
294 | otherwise
295 = filter ((/= rtsUnitId) . unitId) pkg_cfgs_init
296
297 archives <- concatMapM (collectArchives dflags) pkg_cfgs
298
299 ar <- foldl mappend
300 <$> (Archive <$> mapM loadObj modules)
301 <*> mapM loadAr archives
302
303 if toolSettings_ldIsGnuLd (toolSettings dflags)
304 then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar
305 else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar
306
307 -- run ranlib over the archive. write*Ar does *not* create the symbol index.
308 runRanlib logger dflags [GHC.SysTools.FileOption "" output_fn]
309
310
311
312 -- | Compute the output file name of a program.
313 --
314 -- StaticLink boolean is used to indicate if the program is actually a static library
315 -- (e.g., on iOS).
316 --
317 -- Use the provided filename (if any), otherwise use "main.exe" (Windows),
318 -- "a.out (otherwise without StaticLink set), "liba.a". In every case, add the
319 -- extension if it is missing.
320 exeFileName :: Platform -> Bool -> Maybe FilePath -> FilePath
321 exeFileName platform staticLink output_fn
322 | Just s <- output_fn =
323 case platformOS platform of
324 OSMinGW32 -> s <?.> "exe"
325 _ -> if staticLink
326 then s <?.> "a"
327 else s
328 | otherwise =
329 if platformOS platform == OSMinGW32
330 then "main.exe"
331 else if staticLink
332 then "liba.a"
333 else "a.out"
334 where s <?.> ext | null (takeExtension s) = s <.> ext
335 | otherwise = s