never executed always true always false
1 {-# LANGUAGE CPP #-}
2
3 -- | Dynamic linker
4 module GHC.Linker.Dynamic
5 ( linkDynLib
6 -- * Platform-specifics
7 , libmLinkOpts
8 )
9 where
10
11 import GHC.Prelude
12 import GHC.Platform
13 import GHC.Platform.Ways
14
15 import GHC.Driver.Session
16
17 import GHC.Unit.Env
18 import GHC.Unit.Types
19 import GHC.Unit.State
20 import GHC.Linker.MacOS
21 import GHC.Linker.Unit
22 import GHC.SysTools.Tasks
23 import GHC.Utils.Logger
24 import GHC.Utils.TmpFs
25
26 import System.FilePath
27
28 linkDynLib :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
29 linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
30 = do
31 let platform = ue_platform unit_env
32 os = platformOS platform
33
34 -- This is a rather ugly hack to fix dynamically linked
35 -- GHC on Windows. If GHC is linked with -threaded, then
36 -- it links against libHSrts_thr. But if base is linked
37 -- against libHSrts, then both end up getting loaded,
38 -- and things go wrong. We therefore link the libraries
39 -- with the same RTS flags that we link GHC with.
40 dflags | OSMinGW32 <- os
41 , hostWays `hasWay` WayDyn
42 = dflags0 { targetWays_ = hostWays }
43 | otherwise
44 = dflags0
45
46 verbFlags = getVerbFlags dflags
47 o_file = outputFile_ dflags
48
49 pkgs_with_rts <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
50
51 let pkg_lib_paths = collectLibraryDirs (ways dflags) pkgs_with_rts
52 let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
53 get_pkg_lib_path_opts l
54 | osElfTarget os || osMachOTarget os
55 , dynLibLoader dflags == SystemDependent
56 , -- Only if we want dynamic libraries
57 ways dflags `hasWay` WayDyn
58 -- Only use RPath if we explicitly asked for it
59 , useXLinkerRPath dflags os
60 = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
61 -- See Note [-Xlinker -rpath vs -Wl,-rpath]
62 | otherwise = ["-L" ++ l]
63
64 let lib_paths = libraryPaths dflags
65 let lib_path_opts = map ("-L"++) lib_paths
66
67 -- In general we don't want to link our dynamic libs against the RTS
68 -- package, because the RTS lib comes in several flavours and we want to be
69 -- able to pick the flavour when a binary is linked.
70 --
71 -- But:
72 -- * on Windows we need to link the RTS import lib as Windows does not
73 -- allow undefined symbols.
74 --
75 -- * the RTS library path is still added to the library search path above
76 -- in case the RTS is being explicitly linked in (see #3807).
77 --
78 -- * if -flink-rts is used, we link with the rts.
79 --
80 let pkgs_without_rts = filter ((/= rtsUnitId) . unitId) pkgs_with_rts
81 pkgs
82 | OSMinGW32 <- os = pkgs_with_rts
83 | gopt Opt_LinkRts dflags = pkgs_with_rts
84 | otherwise = pkgs_without_rts
85 pkg_link_opts = package_hs_libs ++ extra_libs ++ other_flags
86 where (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs
87
88 -- probably _stub.o files
89 -- and last temporary shared object file
90 let extra_ld_inputs = ldInputs dflags
91
92 -- frameworks
93 pkg_framework_opts <- getUnitFrameworkOpts unit_env (map unitId pkgs)
94 let framework_opts = getFrameworkOpts dflags platform
95
96 case os of
97 OSMinGW32 -> do
98 -------------------------------------------------------------
99 -- Making a DLL
100 -------------------------------------------------------------
101 let output_fn = case o_file of
102 Just s -> s
103 Nothing -> "HSdll.dll"
104
105 runLink logger tmpfs dflags (
106 map Option verbFlags
107 ++ [ Option "-o"
108 , FileOption "" output_fn
109 , Option "-shared"
110 ] ++
111 [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
112 | gopt Opt_SharedImplib dflags
113 ]
114 ++ map (FileOption "") o_files
115
116 -- Permit the linker to auto link _symbol to _imp_symbol
117 -- This lets us link against DLLs without needing an "import library"
118 ++ [Option "-Wl,--enable-auto-import"]
119
120 ++ extra_ld_inputs
121 ++ map Option (
122 lib_path_opts
123 ++ pkg_lib_path_opts
124 ++ pkg_link_opts
125 ))
126 _ | os == OSDarwin -> do
127 -------------------------------------------------------------------
128 -- Making a darwin dylib
129 -------------------------------------------------------------------
130 -- About the options used for Darwin:
131 -- -dynamiclib
132 -- Apple's way of saying -shared
133 -- -undefined dynamic_lookup:
134 -- Without these options, we'd have to specify the correct
135 -- dependencies for each of the dylibs. Note that we could
136 -- (and should) do without this for all libraries except
137 -- the RTS; all we need to do is to pass the correct
138 -- HSfoo_dyn.dylib files to the link command.
139 -- This feature requires Mac OS X 10.3 or later; there is
140 -- a similar feature, -flat_namespace -undefined suppress,
141 -- which works on earlier versions, but it has other
142 -- disadvantages.
143 -- -single_module
144 -- Build the dynamic library as a single "module", i.e. no
145 -- dynamic binding nonsense when referring to symbols from
146 -- within the library. The NCG assumes that this option is
147 -- specified (on i386, at least).
148 -- -install_name
149 -- Mac OS/X stores the path where a dynamic library is (to
150 -- be) installed in the library itself. It's called the
151 -- "install name" of the library. Then any library or
152 -- executable that links against it before it's installed
153 -- will search for it in its ultimate install location.
154 -- By default we set the install name to the absolute path
155 -- at build time, but it can be overridden by the
156 -- -dylib-install-name option passed to ghc. Cabal does
157 -- this.
158 -------------------------------------------------------------------
159
160 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
161
162 instName <- case dylibInstallName dflags of
163 Just n -> return n
164 Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
165 runLink logger tmpfs dflags (
166 map Option verbFlags
167 ++ [ Option "-dynamiclib"
168 , Option "-o"
169 , FileOption "" output_fn
170 ]
171 ++ map Option o_files
172 ++ [ Option "-undefined",
173 Option "dynamic_lookup",
174 Option "-single_module" ]
175 ++ (if platformArch platform `elem` [ ArchX86_64, ArchAArch64 ]
176 then [ ]
177 else [ Option "-Wl,-read_only_relocs,suppress" ])
178 ++ [ Option "-install_name", Option instName ]
179 ++ map Option lib_path_opts
180 ++ extra_ld_inputs
181 ++ map Option framework_opts
182 ++ map Option pkg_lib_path_opts
183 ++ map Option pkg_link_opts
184 ++ map Option pkg_framework_opts
185 -- dead_strip_dylibs, will remove unused dylibs, and thus save
186 -- space in the load commands. The -headerpad is necessary so
187 -- that we can inject more @rpath's later for the leftover
188 -- libraries in the runInjectRpaths phase below.
189 --
190 -- See Note [Dynamic linking on macOS]
191 ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ]
192 )
193 runInjectRPaths logger dflags pkg_lib_paths output_fn
194 _ -> do
195 -------------------------------------------------------------------
196 -- Making a DSO
197 -------------------------------------------------------------------
198
199 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
200 platform = targetPlatform dflags
201 unregisterised = platformUnregisterised platform
202 let bsymbolicFlag = -- we need symbolic linking to resolve
203 -- non-PIC intra-package-relocations for
204 -- performance (where symbolic linking works)
205 -- See Note [-Bsymbolic assumptions by GHC]
206 ["-Wl,-Bsymbolic" | not unregisterised]
207
208 runLink logger tmpfs dflags (
209 map Option verbFlags
210 ++ libmLinkOpts platform
211 ++ [ Option "-o"
212 , FileOption "" output_fn
213 ]
214 ++ map Option o_files
215 ++ [ Option "-shared" ]
216 ++ map Option bsymbolicFlag
217 -- Set the library soname. We use -h rather than -soname as
218 -- Solaris 10 doesn't support the latter:
219 ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
220 ++ extra_ld_inputs
221 ++ map Option lib_path_opts
222 ++ map Option pkg_lib_path_opts
223 ++ map Option pkg_link_opts
224 )
225
226 -- | Some platforms require that we explicitly link against @libm@ if any
227 -- math-y things are used (which we assume to include all programs). See #14022.
228 libmLinkOpts :: Platform -> [Option]
229 libmLinkOpts platform
230 | platformHasLibm platform = [Option "-lm"]
231 | otherwise = []
232
233 {-
234 Note [-Bsymbolic assumptions by GHC]
235 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
236
237 GHC has a few assumptions about interaction of relocations in NCG and linker:
238
239 1. -Bsymbolic resolves internal references when the shared library is linked,
240 which is important for performance.
241 2. When there is a reference to data in a shared library from the main program,
242 the runtime linker relocates the data object into the main program using an
243 R_*_COPY relocation.
244 3. If we used -Bsymbolic, then this results in multiple copies of the data
245 object, because some references have already been resolved to point to the
246 original instance. This is bad!
247
248 We work around [3.] for native compiled code by avoiding the generation of
249 R_*_COPY relocations.
250
251 Unregisterised compiler can't evade R_*_COPY relocations easily thus we disable
252 -Bsymbolic linking there.
253
254 See related tickets: #4210, #15338
255 -}