X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=c0aed96e7051f3530152af9c7f505e05196da10d;hp=0bac958418acfb09565ce21d3c285dc7fd6cd673;hb=c9959e41ee1d72aa0ca28d51580f1ad3c06f0e8b;hpb=c4a120e767e9640de7f02456a6c91611f44d2e94 diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 0bac958..c0aed96 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -35,7 +35,7 @@ import Finder import HscTypes import Outputable import Module -import LazyUniqFM ( eltsUFM ) +import UniqFM ( eltsUFM ) import ErrUtils import DynFlags import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) ) @@ -1299,6 +1299,20 @@ wrapper_behaviour dflags mode dep_packages = putStrLn (unwords (map (packageIdString . packageConfigId) allpkg)) return $ 'F':s ++ ';':(seperateBySemiColon (map (packageIdString . packageConfigId) allpkg)) +mkExtraCObj :: DynFlags -> [String] -> IO FilePath +mkExtraCObj dflags xs + = do cFile <- newTempName dflags "c" + oFile <- newTempName dflags "o" + writeFile cFile $ unlines xs + let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId + SysTools.runCc dflags + ([Option "-c", + FileOption "" cFile, + Option "-o", + FileOption "" oFile] ++ + map (FileOption "-I") (includeDirs rtsDetails)) + return oFile + -- generates a Perl skript starting a parallel prg under PVM mk_pvm_wrapper_script :: String -> String -> String -> String mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $ @@ -1409,6 +1423,20 @@ linkBinary dflags o_files dep_packages = do let no_hs_main = dopt Opt_NoHsMain dflags let main_lib | no_hs_main = [] | otherwise = [ "-lHSrtsmain" ] + rtsEnabledObj <- if dopt Opt_RtsOptsEnabled dflags + then do fn <- mkExtraCObj dflags + ["#include \"Rts.h\"", + "const rtsBool rtsOptsEnabled = rtsTrue;"] + return [fn] + else return [] + rtsOptsObj <- case rtsOpts dflags of + Just opts -> + do fn <- mkExtraCObj dflags + -- We assume that the Haskell "show" does + -- the right thing here + ["char *ghc_rts_opts = " ++ show opts ++ ";"] + return [fn] + Nothing -> return [] pkg_link_opts <- getPackageLinkOpts dflags dep_packages @@ -1483,6 +1511,8 @@ linkBinary dflags o_files dep_packages = do #endif ++ pkg_lib_path_opts ++ main_lib + ++ rtsEnabledObj + ++ rtsOptsObj ++ pkg_link_opts #ifdef darwin_TARGET_OS ++ pkg_framework_path_opts @@ -1701,6 +1731,14 @@ linkDynLib dflags o_files dep_packages = do ----------------------------------------------------------------------------- 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 ([ SysTools.Option verb @@ -1710,7 +1748,8 @@ linkDynLib dflags o_files dep_packages = do ++ map SysTools.Option ( md_c_flags ++ o_files - ++ [ "-shared", "-Wl,-Bsymbolic" ] -- we need symbolic linking to resolve non-PIC intra-package-relocations + ++ [ "-shared" ] + ++ bsymbolicFlag ++ [ "-Wl,-soname," ++ takeFileName output_fn ] -- set the library soname ++ extra_ld_inputs ++ lib_path_opts