diff options
| -rw-r--r-- | compiler/ghci/Linker.lhs | 63 | ||||
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 173 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 71 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 4 | ||||
| -rw-r--r-- | compiler/main/HscTypes.lhs | 9 | ||||
| -rw-r--r-- | compiler/main/SysTools.lhs | 170 | ||||
| -rw-r--r-- | rts/Linker.c | 18 | ||||
| -rw-r--r-- | rts/ghc.mk | 4 |
8 files changed, 294 insertions, 218 deletions
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 8f572e85a7..f4a5ca5050 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -415,11 +415,17 @@ preloadLib dflags lib_paths framework_paths lib_spec preload_static _paths name = do b <- doesFileExist name if not b then return False - else loadObj name >> return True + else do if dYNAMIC_BY_DEFAULT dflags + then dynLoadObjs dflags [name] + else loadObj name + return True preload_static_archive _paths name = do b <- doesFileExist name if not b then return False - else loadArchive name >> return True + else do if dYNAMIC_BY_DEFAULT dflags + then panic "Loading archives not supported" + else loadArchive name + return True \end{code} @@ -783,20 +789,45 @@ dynLinkObjs dflags pls objs = do let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs pls1 = pls { objs_loaded = objs_loaded' } unlinkeds = concatMap linkableUnlinked new_objs - - mapM_ loadObj (map nameOfObject unlinkeds) - - -- Link them all together - ok <- resolveObjs - - -- If resolving failed, unload all our - -- object modules and carry on - if succeeded ok then do - return (pls1, Succeeded) - else do - pls2 <- unload_wkr dflags [] pls1 - return (pls2, Failed) - + wanted_objs = map nameOfObject unlinkeds + + if dYNAMIC_BY_DEFAULT dflags + then do dynLoadObjs dflags wanted_objs + return (pls, Succeeded) + else do mapM_ loadObj wanted_objs + + -- Link them all together + ok <- resolveObjs + + -- If resolving failed, unload all our + -- object modules and carry on + if succeeded ok then do + return (pls1, Succeeded) + else do + pls2 <- unload_wkr dflags [] pls1 + return (pls2, Failed) + +dynLoadObjs :: DynFlags -> [FilePath] -> IO () +dynLoadObjs dflags objs = do + let platform = targetPlatform dflags + soFile <- newTempName dflags (soExt platform) + let -- When running TH for a non-dynamic way, we still need to make + -- -l flags to link against the dynamic libraries, so we turn + -- Opt_Static off + dflags1 = dopt_unset dflags Opt_Static + dflags2 = dflags1 { + -- We don't want to link the ldInputs in; we'll + -- be calling dynLoadObjs with any objects that + -- need to be linked. + ldInputs = [], + outputFile = Just soFile + } + linkDynLib dflags2 objs [] + consIORef (filesToNotIntermediateClean dflags) soFile + m <- loadDLL soFile + case m of + Nothing -> return () + Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded -> [Linkable] -- New linkables diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 08420efde6..d7b80e62fb 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -330,7 +330,7 @@ link' dflags batch_attempt_linking hpt -- Don't showPass in Batch mode; doLink will do that for us. let link = case ghcLink dflags of LinkBinary -> linkBinary - LinkDynLib -> linkDynLib + LinkDynLib -> linkDynLibCheck other -> panicBadLink other link dflags obj_files pkg_deps @@ -465,8 +465,8 @@ doLink dflags stop_phase o_files | otherwise = case ghcLink dflags of NoLink -> return () - LinkBinary -> linkBinary dflags o_files [] - LinkDynLib -> linkDynLib dflags o_files [] + LinkBinary -> linkBinary dflags o_files [] + LinkDynLib -> linkDynLibCheck dflags o_files [] other -> panicBadLink other @@ -1884,176 +1884,15 @@ maybeCreateManifest dflags exe_filename | otherwise = return [] -linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO () -linkDynLib dflags o_files dep_packages +linkDynLibCheck :: DynFlags -> [String] -> [PackageId] -> IO () +linkDynLibCheck dflags o_files dep_packages = do when (haveRtsOptsFlags dflags) $ do log_action dflags dflags SevInfo noSrcSpan defaultUserStyle (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$ text " Call hs_init_ghc() from your main() function to set these options.") - let verbFlags = getVerbFlags dflags - let o_file = outputFile dflags - - pkgs <- getPreloadPackagesAnd dflags dep_packages - - let pkg_lib_paths = collectLibraryPaths pkgs - let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths - get_pkg_lib_path_opts l - | osElfTarget (platformOS (targetPlatform dflags)) && - dynLibLoader dflags == SystemDependent && - not (dopt Opt_Static dflags) - = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] - | otherwise = ["-L" ++ l] - - let lib_paths = libraryPaths dflags - let lib_path_opts = map ("-L"++) lib_paths - - -- We don't want to link our dynamic libs against the RTS package, - -- because the RTS lib comes in several flavours and we want to be - -- able to pick the flavour when a binary is linked. - -- On Windows we need to link the RTS import lib as Windows does - -- not allow undefined symbols. - -- The RTS library path is still added to the library search path - -- above in case the RTS is being explicitly linked in (see #3807). - let platform = targetPlatform dflags - os = platformOS platform - pkgs_no_rts = case os of - OSMinGW32 -> - pkgs - _ -> - filter ((/= rtsPackageId) . packageConfigId) pkgs - let pkg_link_opts = collectLinkOpts dflags pkgs_no_rts - - -- probably _stub.o files - let extra_ld_inputs = ldInputs dflags - - let extra_ld_opts = getOpts dflags opt_l - - case os of - OSMinGW32 -> do - ------------------------------------------------------------- - -- Making a DLL - ------------------------------------------------------------- - let output_fn = case o_file of - Just s -> s - Nothing -> "HSdll.dll" - - SysTools.runLink dflags ( - map SysTools.Option verbFlags - ++ [ SysTools.Option "-o" - , SysTools.FileOption "" output_fn - , SysTools.Option "-shared" - ] ++ - [ SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a") - | dopt Opt_SharedImplib dflags - ] - ++ map (SysTools.FileOption "") o_files - ++ map SysTools.Option ( - - -- Permit the linker to auto link _symbol to _imp_symbol - -- This lets us link against DLLs without needing an "import library" - ["-Wl,--enable-auto-import"] - - ++ extra_ld_inputs - ++ lib_path_opts - ++ extra_ld_opts - ++ pkg_lib_path_opts - ++ pkg_link_opts - )) - OSDarwin -> do - ------------------------------------------------------------------- - -- Making a darwin dylib - ------------------------------------------------------------------- - -- About the options used for Darwin: - -- -dynamiclib - -- Apple's way of saying -shared - -- -undefined dynamic_lookup: - -- Without these options, we'd have to specify the correct - -- dependencies for each of the dylibs. Note that we could - -- (and should) do without this for all libraries except - -- the RTS; all we need to do is to pass the correct - -- HSfoo_dyn.dylib files to the link command. - -- This feature requires Mac OS X 10.3 or later; there is - -- a similar feature, -flat_namespace -undefined suppress, - -- which works on earlier versions, but it has other - -- disadvantages. - -- -single_module - -- Build the dynamic library as a single "module", i.e. no - -- dynamic binding nonsense when referring to symbols from - -- within the library. The NCG assumes that this option is - -- specified (on i386, at least). - -- -install_name - -- Mac OS/X stores the path where a dynamic library is (to - -- be) installed in the library itself. It's called the - -- "install name" of the library. Then any library or - -- executable that links against it before it's installed - -- will search for it in its ultimate install location. - -- By default we set the install name to the absolute path - -- at build time, but it can be overridden by the - -- -dylib-install-name option passed to ghc. Cabal does - -- this. - ------------------------------------------------------------------- - - let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } - - instName <- case dylibInstallName dflags of - Just n -> return n - Nothing -> do - pwd <- getCurrentDirectory - return $ pwd `combine` output_fn - SysTools.runLink dflags ( - map SysTools.Option verbFlags - ++ [ SysTools.Option "-dynamiclib" - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn - ] - ++ map SysTools.Option ( - o_files - ++ [ "-undefined", "dynamic_lookup", "-single_module" ] - ++ (if platformArch platform == ArchX86_64 - then [ ] - else [ "-Wl,-read_only_relocs,suppress" ]) - ++ [ "-install_name", instName ] - ++ extra_ld_inputs - ++ lib_path_opts - ++ extra_ld_opts - ++ pkg_lib_path_opts - ++ pkg_link_opts - )) - _ -> do - ------------------------------------------------------------------- - -- Making a DSO - ------------------------------------------------------------------- - - let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } - let buildingRts = thisPackage dflags == rtsPackageId - let bsymbolicFlag = if buildingRts - then -- -Bsymbolic breaks the way we implement - -- hooks in the RTS - [] - else -- we need symbolic linking to resolve - -- non-PIC intra-package-relocations - ["-Wl,-Bsymbolic"] - - SysTools.runLink dflags ( - map SysTools.Option verbFlags - ++ [ SysTools.Option "-o" - , SysTools.FileOption "" output_fn - ] - ++ map SysTools.Option ( - o_files - ++ [ "-shared" ] - ++ bsymbolicFlag - -- Set the library soname. We use -h rather than -soname as - -- Solaris 10 doesn't support the latter: - ++ [ "-Wl,-h," ++ takeFileName output_fn ] - ++ extra_ld_inputs - ++ lib_path_opts - ++ extra_ld_opts - ++ pkg_lib_path_opts - ++ pkg_link_opts - )) + linkDynLib dflags o_files dep_packages -- ----------------------------------------------------------------------------- -- Running CPP diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 35821b0114..a5fcd1bc4a 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -641,6 +641,8 @@ data DynFlags = DynFlags { -- know what to clean when an exception happens filesToClean :: IORef [FilePath], dirsToClean :: IORef (Map FilePath FilePath), + filesToNotIntermediateClean :: IORef [FilePath], + -- Names of files which were generated from -ddump-to-file; used to -- track which ones we need to truncate because it's our first run @@ -908,7 +910,7 @@ data PackageFlag | IgnorePackage String | TrustPackage String | DistrustPackage String - deriving Eq + deriving (Eq, Show) defaultHscTarget :: Platform -> HscTarget defaultHscTarget = defaultObjectTarget @@ -1022,29 +1024,35 @@ wayDesc WayPar = "Parallel" wayDesc WayGran = "GranSim" wayDesc WayNDP = "Nested data parallelism" +wayDynFlags :: Platform -> Way -> [DynFlag] +wayDynFlags _ WayThreaded = [] +wayDynFlags _ WayDebug = [] +wayDynFlags platform WayDyn = + case platformOS platform of + -- On Windows, code that is to be linked into a dynamic + -- library must be compiled with -fPIC. Labels not in + -- the current package are assumed to be in a DLL + -- different from the current one. + OSMinGW32 -> [Opt_PIC] + OSDarwin -> [Opt_PIC] + OSLinux -> [Opt_PIC] + _ -> [] +wayDynFlags _ WayProf = [Opt_SccProfilingOn] +wayDynFlags _ WayEventLog = [] +wayDynFlags _ WayPar = [Opt_Parallel] +wayDynFlags _ WayGran = [Opt_GranMacros] +wayDynFlags _ WayNDP = [] + wayExtras :: Platform -> Way -> DynP () wayExtras _ WayThreaded = return () -wayExtras _ WayDebug = return () -wayExtras platform WayDyn = - case platformOS platform of - OSMinGW32 -> - -- On Windows, code that is to be linked into a dynamic - -- library must be compiled with -fPIC. Labels not in - -- the current package are assumed to be in a DLL - -- different from the current one. - setFPIC - OSDarwin -> - setFPIC - _ -> - return () -wayExtras _ WayProf = setDynFlag Opt_SccProfilingOn +wayExtras _ WayDebug = return () +wayExtras _ WayDyn = return () +wayExtras _ WayProf = return () wayExtras _ WayEventLog = return () -wayExtras _ WayPar = do setDynFlag Opt_Parallel - exposePackage "concurrent" -wayExtras _ WayGran = do setDynFlag Opt_GranMacros - exposePackage "concurrent" -wayExtras _ WayNDP = do setExtensionFlag Opt_ParallelArrays - setDynFlag Opt_Vectorise +wayExtras _ WayPar = exposePackage "concurrent" +wayExtras _ WayGran = exposePackage "concurrent" +wayExtras _ WayNDP = do setExtensionFlag Opt_ParallelArrays + setDynFlag Opt_Vectorise wayOptc :: Platform -> Way -> [String] wayOptc platform WayThreaded = case platformOS platform of @@ -1106,11 +1114,13 @@ initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do refFilesToClean <- newIORef [] refDirsToClean <- newIORef Map.empty + refFilesToNotIntermediateClean <- newIORef [] refGeneratedDumps <- newIORef Set.empty refLlvmVersion <- newIORef 28 return dflags{ filesToClean = refFilesToClean, dirsToClean = refDirsToClean, + filesToNotIntermediateClean = refFilesToNotIntermediateClean, generatedDumps = refGeneratedDumps, llvmVersion = refLlvmVersion } @@ -1192,6 +1202,7 @@ defaultDynFlags mySettings = -- end of ghc -M values filesToClean = panic "defaultDynFlags: No filesToClean", dirsToClean = panic "defaultDynFlags: No dirsToClean", + filesToNotIntermediateClean = panic "defaultDynFlags: No filesToNotIntermediateClean", generatedDumps = panic "defaultDynFlags: No generatedDumps", haddockOptions = Nothing, flags = IntSet.fromList (map fromEnum (defaultFlags mySettings)), @@ -2130,8 +2141,8 @@ dynamic_flags = [ ------ Safe Haskell flags ------------------------------------------- , Flag "fpackage-trust" (NoArg setPackageTrust) , Flag "fno-safe-infer" (NoArg (setSafeHaskell Sf_None)) - , Flag "fPIC" (NoArg setFPIC) - , Flag "fno-PIC" (NoArg unSetFPIC) + , Flag "fPIC" (NoArg (setDynFlag Opt_PIC)) + , Flag "fno-PIC" (NoArg (unSetDynFlag Opt_PIC)) ] ++ map (mkFlag turnOn "" setDynFlag ) negatableFlags ++ map (mkFlag turnOff "no-" unSetDynFlag) negatableFlags @@ -2532,7 +2543,7 @@ defaultFlags settings _ -> []) ++ (if pc_dYNAMIC_BY_DEFAULT (sPlatformConstants settings) - then [] + then wayDynFlags platform WayDyn else [Opt_Static]) where platform = sTargetPlatform settings @@ -2803,7 +2814,9 @@ setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) addWay :: Way -> DynP () addWay w = do upd (\dfs -> dfs { ways = w : ways dfs }) dfs <- liftEwM getCmdLineState - wayExtras (targetPlatform dfs) w + let platform = targetPlatform dfs + wayExtras platform w + mapM_ setDynFlag $ wayDynFlags platform w removeWay :: Way -> DynP () removeWay w = upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) }) @@ -2943,14 +2956,6 @@ setObjTarget l = updM set = return $ dflags { hscTarget = l } | otherwise = return dflags -setFPIC :: DynP () -setFPIC = updM set - where set dflags = return $ dopt_set dflags Opt_PIC - -unSetFPIC :: DynP () -unSetFPIC = updM set - where set dflags = return $ dopt_unset dflags Opt_PIC - setOptLevel :: Int -> DynFlags -> DynP DynFlags setOptLevel n dflags | hscTarget dflags == HscInterpreted && n > 0 diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 322c631a4c..6dd27029f1 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -55,6 +55,7 @@ import qualified Data.Map as Map import qualified FiniteMap as Map ( insertListWith ) import Control.Monad +import Data.IORef import Data.List import qualified Data.List as List import Data.Maybe @@ -364,7 +365,8 @@ discardIC hsc_env intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO () intermediateCleanTempFiles dflags summaries hsc_env - = cleanTempFilesExcept dflags except + = do notIntermediate <- readIORef (filesToNotIntermediateClean dflags) + cleanTempFilesExcept dflags (notIntermediate ++ except) where except = -- Save preprocessed files. The preprocessed file *might* be diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index ec5f6ee792..a56bcabea8 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -37,7 +37,7 @@ module HscTypes ( PackageInstEnv, PackageRuleBase, - mkSOName, + mkSOName, soExt, -- * Annotations prepareAnnotations, @@ -1788,6 +1788,13 @@ mkSOName platform root OSDarwin -> ("lib" ++ root) <.> "dylib" OSMinGW32 -> root <.> "dll" _ -> ("lib" ++ root) <.> "so" + +soExt :: Platform -> FilePath +soExt platform + = case platformOS platform of + OSDarwin -> "dylib" + OSMinGW32 -> "dll" + _ -> "so" \end{code} diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 2154cd3235..eeebe694ac 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -24,6 +24,8 @@ module SysTools ( figureLlvmVersion, readElfSection, + linkDynLib, + askCc, touch, -- String -> String -> IO () @@ -43,6 +45,8 @@ module SysTools ( #include "HsVersions.h" import DriverPhases +import Module +import Packages import Config import Outputable import ErrUtils @@ -1036,4 +1040,170 @@ linesPlatform xs = #endif +linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO () +linkDynLib dflags o_files dep_packages + = do + let verbFlags = getVerbFlags dflags + let o_file = outputFile dflags + + pkgs <- getPreloadPackagesAnd dflags dep_packages + + let pkg_lib_paths = collectLibraryPaths pkgs + let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths + get_pkg_lib_path_opts l + | osElfTarget (platformOS (targetPlatform dflags)) && + dynLibLoader dflags == SystemDependent && + not (dopt Opt_Static dflags) + = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] + | otherwise = ["-L" ++ l] + + let lib_paths = libraryPaths dflags + let lib_path_opts = map ("-L"++) lib_paths + + -- We don't want to link our dynamic libs against the RTS package, + -- because the RTS lib comes in several flavours and we want to be + -- able to pick the flavour when a binary is linked. + -- On Windows we need to link the RTS import lib as Windows does + -- not allow undefined symbols. + -- The RTS library path is still added to the library search path + -- above in case the RTS is being explicitly linked in (see #3807). + let platform = targetPlatform dflags + os = platformOS platform + pkgs_no_rts = case os of + OSMinGW32 -> + pkgs + _ -> + filter ((/= rtsPackageId) . packageConfigId) pkgs + let pkg_link_opts = collectLinkOpts dflags pkgs_no_rts + + -- probably _stub.o files + let extra_ld_inputs = ldInputs dflags + + let extra_ld_opts = getOpts dflags opt_l + + case os of + OSMinGW32 -> do + ------------------------------------------------------------- + -- Making a DLL + ------------------------------------------------------------- + let output_fn = case o_file of + Just s -> s + Nothing -> "HSdll.dll" + + runLink dflags ( + map Option verbFlags + ++ [ Option "-o" + , FileOption "" output_fn + , Option "-shared" + ] ++ + [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a") + | dopt Opt_SharedImplib dflags + ] + ++ map (FileOption "") o_files + ++ map Option ( + + -- Permit the linker to auto link _symbol to _imp_symbol + -- This lets us link against DLLs without needing an "import library" + ["-Wl,--enable-auto-import"] + + ++ extra_ld_inputs + ++ lib_path_opts + ++ extra_ld_opts + ++ pkg_lib_path_opts + ++ pkg_link_opts + )) + OSDarwin -> do + ------------------------------------------------------------------- + -- Making a darwin dylib + ------------------------------------------------------------------- + -- About the options used for Darwin: + -- -dynamiclib + -- Apple's way of saying -shared + -- -undefined dynamic_lookup: + -- Without these options, we'd have to specify the correct + -- dependencies for each of the dylibs. Note that we could + -- (and should) do without this for all libraries except + -- the RTS; all we need to do is to pass the correct + -- HSfoo_dyn.dylib files to the link command. + -- This feature requires Mac OS X 10.3 or later; there is + -- a similar feature, -flat_namespace -undefined suppress, + -- which works on earlier versions, but it has other + -- disadvantages. + -- -single_module + -- Build the dynamic library as a single "module", i.e. no + -- dynamic binding nonsense when referring to symbols from + -- within the library. The NCG assumes that this option is + -- specified (on i386, at least). + -- -install_name + -- Mac OS/X stores the path where a dynamic library is (to + -- be) installed in the library itself. It's called the + -- "install name" of the library. Then any library or + -- executable that links against it before it's installed + -- will search for it in its ultimate install location. + -- By default we set the install name to the absolute path + -- at build time, but it can be overridden by the + -- -dylib-install-name option passed to ghc. Cabal does + -- this. + ------------------------------------------------------------------- + + let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } + + instName <- case dylibInstallName dflags of + Just n -> return n + Nothing -> do + pwd <- getCurrentDirectory + return $ pwd `combine` output_fn + runLink dflags ( + map Option verbFlags + ++ [ Option "-dynamiclib" + , Option "-o" + , FileOption "" output_fn + ] + ++ map Option ( + o_files + ++ [ "-undefined", "dynamic_lookup", "-single_module" ] + ++ (if platformArch platform == ArchX86_64 + then [ ] + else [ "-Wl,-read_only_relocs,suppress" ]) + ++ [ "-install_name", instName ] + ++ extra_ld_inputs + ++ lib_path_opts + ++ extra_ld_opts + ++ pkg_lib_path_opts + ++ pkg_link_opts + )) + _ -> do + ------------------------------------------------------------------- + -- Making a DSO + ------------------------------------------------------------------- + + let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } + let buildingRts = thisPackage dflags == rtsPackageId + let bsymbolicFlag = if buildingRts + then -- -Bsymbolic breaks the way we implement + -- hooks in the RTS + [] + else -- we need symbolic linking to resolve + -- non-PIC intra-package-relocations + ["-Wl,-Bsymbolic"] + + runLink dflags ( + map Option verbFlags + ++ [ Option "-o" + , FileOption "" output_fn + ] + ++ map Option ( + o_files + ++ [ "-shared" ] + ++ bsymbolicFlag + -- Set the library soname. We use -h rather than -soname as + -- Solaris 10 doesn't support the latter: + ++ [ "-Wl,-h," ++ takeFileName output_fn ] + ++ extra_ld_inputs + ++ lib_path_opts + ++ extra_ld_opts + ++ pkg_lib_path_opts + ++ pkg_link_opts + )) + \end{code} diff --git a/rts/Linker.c b/rts/Linker.c index 64d60f23d0..4ae9193a11 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -137,6 +137,16 @@ #include <sys/tls.h> #endif +// Defining this as 'int' rather than 'const int' means that we don't get +// warnings like +// error: function might be possible candidate for attribute ‘noreturn’ +// from gcc: +#ifdef DYNAMIC_BY_DEFAULT +int dynamicByDefault = 1; +#else +int dynamicByDefault = 0; +#endif + /* Hash table mapping symbol names to Symbol */ static /*Str*/HashTable *symhash; @@ -2044,6 +2054,10 @@ loadArchive( pathchar *path ) IF_DEBUG(linker, debugBelch("loadArchive: start\n")); IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path)); + if (dynamicByDefault) { + barf("loadArchive called, but using dynlibs by default (%s)", path); + } + gnuFileIndex = NULL; gnuFileIndexSize = 0; @@ -2435,6 +2449,10 @@ loadObj( pathchar *path ) #endif IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path)); + if (dynamicByDefault) { + barf("loadObj called, but using dynlibs by default (%s)", path); + } + initLinker(); /* debugBelch("loadObj %s\n", path ); */ diff --git a/rts/ghc.mk b/rts/ghc.mk index 726199e455..b01f199a86 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -316,6 +316,10 @@ rts/RtsUtils_CC_OPTS += -DTargetVendor=\"$(TargetVendor_CPP)\" rts/RtsUtils_CC_OPTS += -DGhcUnregisterised=\"$(GhcUnregisterised)\" rts/RtsUtils_CC_OPTS += -DGhcEnableTablesNextToCode=\"$(GhcEnableTablesNextToCode)\" +ifeq "$(DYNAMIC_BY_DEFAULT)" "YES" +rts/Linker_CC_OPTS += -DDYNAMIC_BY_DEFAULT +endif + # Compile various performance-critical pieces *without* -fPIC -dynamic # even when building a shared library. If we don't do this, then the # GC runs about 50% slower on x86 due to the overheads of PIC. The |