When dynamic-by-default, don't use the GHCi linker
authorIan Lynagh <ian@well-typed.com>
Sat, 13 Oct 2012 13:42:52 +0000 (14:42 +0100)
committerIan Lynagh <ian@well-typed.com>
Sat, 13 Oct 2012 13:42:52 +0000 (14:42 +0100)
We instead link objects into a temporary DLL and dlopen that

compiler/ghci/Linker.lhs
compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/GhcMake.hs
compiler/main/HscTypes.lhs
compiler/main/SysTools.lhs
rts/Linker.c
rts/ghc.mk

index 8f572e8..f4a5ca5 100644 (file)
@@ -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
index 08420ef..d7b80e6 100644 (file)
@@ -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
index 35821b0..a5fcd1b 100644 (file)
@@ -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
index 322c631..6dd2702 100644 (file)
@@ -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
index ec5f6ee..a56bcab 100644 (file)
@@ -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}
 
 
index 2154cd3..eeebe69 100644 (file)
@@ -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}
index 64d60f2..4ae9193 100644 (file)
 #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 ); */
index 726199e..b01f199 100644 (file)
@@ -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