X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=c690e84ed00d45929e066b98142e58cb77ca409f;hb=28879d9b3afe1812810d42f14eda6dfa4aa6dc73;hp=af6849f18a67980647353e56723b601196d369a9;hpb=60873542e8edf0ee593fde2b6544770d8036728f;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index af6849f..c690e84 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -461,15 +461,9 @@ doLink dflags stop_phase o_files | otherwise = case ghcLink dflags of NoLink -> return () - LinkBinary -> linkBinary dflags o_files link_pkgs + LinkBinary -> linkBinary dflags o_files [] LinkDynLib -> linkDynLib dflags o_files [] other -> panicBadLink other - where - -- Always link in the haskell98 package for static linking. Other - -- packages have to be specified via the -package flag. - link_pkgs - | dopt Opt_AutoLinkPackages dflags = [haskell98PackageId] - | otherwise = [] -- --------------------------------------------------------------------------- @@ -707,7 +701,7 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc checkProcessArgsResult unhandled_flags let dflags1' = flattenExtensionFlags dflags1 - if not (dopt Opt_Cpp dflags1') then do + if not (xopt Opt_Cpp dflags1') then do -- we have to be careful to emit warnings only once. unless (dopt Opt_Pp dflags1') $ handleFlagWarnings dflags1' warns @@ -1336,8 +1330,8 @@ runPhase other _stop _dflags _basename _suff _input_fn _get_output_fn _maybe_loc -- we don't need the generality of a phase (MoveBinary is always -- done after linking and makes only sense in a parallel setup) -- HWL -runPhase_MoveBinary :: DynFlags -> FilePath -> [PackageId] -> IO Bool -runPhase_MoveBinary dflags input_fn dep_packages +runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool +runPhase_MoveBinary dflags input_fn | WayPar `elem` (wayNames dflags) && not opt_Static = panic ("Don't know how to combine PVM wrapper and dynamic wrapper") | WayPar `elem` (wayNames dflags) = do @@ -1354,43 +1348,8 @@ runPhase_MoveBinary dflags input_fn dep_packages -- generate a wrapper script for running a parallel prg under PVM writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan) return True - | not opt_Static = - case (dynLibLoader dflags) of - Wrapped wrapmode -> - do - let (o_base, o_ext) = splitExtension input_fn - let wrapped_executable | o_ext == "exe" = (o_base ++ ".dyn") <.> o_ext - | otherwise = input_fn ++ ".dyn" - behaviour <- wrapper_behaviour dflags wrapmode dep_packages - - -- THINKME isn't this possible to do a bit nicer? - let behaviour' = concatMap (\x -> if x=='\\' then "\\\\" else [x]) behaviour - renameFile input_fn wrapped_executable - let rtsDetails = (getPackageDetails (pkgState dflags) rtsPackageId); - (md_c_flags, _) = machdepCCOpts dflags - SysTools.runCc dflags - ([ SysTools.FileOption "" ((head (libraryDirs rtsDetails)) ++ "/dyn-wrapper.c") - , SysTools.Option ("-DBEHAVIOUR=\"" ++ behaviour' ++ "\"") - , SysTools.Option "-o" - , SysTools.FileOption "" input_fn] ++ - map (SysTools.FileOption "-I") (includeDirs rtsDetails) ++ - map Option md_c_flags) - return True - _ -> return True | otherwise = return True -wrapper_behaviour :: DynFlags -> Maybe [Char] -> [PackageId] -> IO [Char] -wrapper_behaviour dflags mode dep_packages = - let seperateBySemiColon strs = tail $ concatMap (';':) strs - in case mode of - Nothing -> do - pkg_lib_paths <- getPackageLibraryPath dflags dep_packages - return ('H' : (seperateBySemiColon pkg_lib_paths)) - Just s -> do - allpkg <- getPreloadPackagesAnd dflags 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" @@ -1573,7 +1532,7 @@ linkBinary dflags o_files dep_packages = do let thread_opts | WayThreaded `elem` ways = [ -#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) && !defined(haiku_TARGET_OS) +#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) && !defined(openbsd_TARGET_OS) && !defined(haiku_TARGET_OS) "-lpthread" #endif #if defined(osf3_TARGET_OS) @@ -1621,7 +1580,7 @@ linkBinary dflags o_files dep_packages = do )) -- parallel only: move binary to another dir -- HWL - success <- runPhase_MoveBinary dflags output_fn dep_packages + success <- runPhase_MoveBinary dflags output_fn if success then return () else ghcError (InstallationError ("cannot move binary")) @@ -1706,19 +1665,9 @@ linkDynLib dflags o_files dep_packages = do let verb = getVerbFlag dflags let o_file = outputFile dflags - -- 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. pkgs <- getPreloadPackagesAnd dflags dep_packages - -- On Windows we need to link the RTS import lib as Windows does - -- not allow undefined symbols. -#if !defined(mingw32_HOST_OS) - let pkgs_no_rts = filter ((/= rtsPackageId) . packageConfigId) pkgs -#else - let pkgs_no_rts = pkgs -#endif - let pkg_lib_paths = collectLibraryPaths pkgs_no_rts + let pkg_lib_paths = collectLibraryPaths pkgs let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths #ifdef elf_OBJ_FORMAT get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] @@ -1730,6 +1679,18 @@ linkDynLib dflags o_files dep_packages = do 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). +#if !defined(mingw32_HOST_OS) + let pkgs_no_rts = filter ((/= rtsPackageId) . packageConfigId) pkgs +#else + let pkgs_no_rts = pkgs +#endif let pkg_link_opts = collectLinkOpts dflags pkgs_no_rts -- probably _stub.o files @@ -1905,17 +1866,10 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do , SysTools.FileOption "" output_fn ]) -cHaskell1Version :: String -cHaskell1Version = "5" -- i.e., Haskell 98 - hsSourceCppOpts :: [String] -- Default CPP defines in Haskell source hsSourceCppOpts = - [ "-D__HASKELL1__="++cHaskell1Version - , "-D__GLASGOW_HASKELL__="++cProjectVersionInt - , "-D__HASKELL98__" - , "-D__CONCURRENT_HASKELL__" - ] + [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ] -- -----------------------------------------------------------------------------