X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=f748f7cd843bb61f79ad626c6e74195b1bbc7304;hb=78b2f856c526e4ae8f8e935b4333fcaf67e7ca84;hp=1871915ffd8bc1a3b76f11776bfc3e1ded6e5bed;hpb=80cabc9a332eaf58ab5ed3d5340d7881df9d5399;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 1871915..f748f7c 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(..) ) @@ -696,19 +696,30 @@ runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_l runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = do let dflags0 = hsc_dflags hsc_env src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn - (dflags, unhandled_flags, warns) + (dflags1, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts - handleFlagWarnings dflags warns checkProcessArgsResult unhandled_flags - if not (dopt Opt_Cpp dflags) then + if not (dopt Opt_Cpp dflags1) then do + -- we have to be careful to emit warnings only once. + unless (dopt Opt_Pp dflags1) $ handleFlagWarnings dflags1 warns + -- no need to preprocess CPP, just pass input file along -- to the next phase of the pipeline. - return (HsPp sf, dflags, maybe_loc, input_fn) + return (HsPp sf, dflags1, maybe_loc, input_fn) else do - output_fn <- liftIO $ get_output_fn dflags (HsPp sf) maybe_loc - liftIO $ doCpp dflags True{-raw-} False{-no CC opts-} input_fn output_fn - return (HsPp sf, dflags, maybe_loc, output_fn) + output_fn <- liftIO $ get_output_fn dflags1 (HsPp sf) maybe_loc + liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-} input_fn output_fn + -- re-read the pragmas now that we've preprocessed the file + -- See #2464,#3457 + src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn + (dflags2, unhandled_flags, warns) + <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts + unless (dopt Opt_Pp dflags2) $ handleFlagWarnings dflags2 warns + -- the HsPp pass below will emit warnings + checkProcessArgsResult unhandled_flags + + return (HsPp sf, dflags2, maybe_loc, output_fn) ------------------------------------------------------------------------------- -- HsPp phase @@ -730,7 +741,15 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc ] ++ map SysTools.Option hspp_opts ) - return (Hsc sf, dflags, maybe_loc, output_fn) + + -- re-read pragmas now that we've parsed the file (see #3674) + src_opts <- liftIO $ getOptionsFromFile dflags output_fn + (dflags1, unhandled_flags, warns) + <- liftIO $ parseDynamicNoPackageFlags dflags src_opts + handleFlagWarnings dflags1 warns + checkProcessArgsResult unhandled_flags + + return (Hsc sf, dflags1, maybe_loc, output_fn) ----------------------------------------------------------------------------- -- Hsc phase @@ -807,6 +826,7 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma src_timestamp <- liftIO $ getModificationTime (basename <.> suff) let force_recomp = dopt Opt_ForceRecomp dflags + hsc_lang = hscMaybeAdjustTarget dflags stop src_flavour (hscTarget dflags) source_unchanged <- if force_recomp || not (isStopLn stop) -- Set source_unchanged to False unconditionally if @@ -823,7 +843,6 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma else return False -- get the DynFlags - let hsc_lang = hscMaybeAdjustTarget dflags stop src_flavour (hscTarget dflags) let next_phase = hscNextPhase dflags src_flavour hsc_lang output_fn <- liftIO $ get_output_fn dflags next_phase (Just location4) @@ -1280,6 +1299,22 @@ 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 + (md_c_flags, _) = machdepCCOpts dflags + SysTools.runCc dflags + ([Option "-c", + FileOption "" cFile, + Option "-o", + FileOption "" oFile] ++ + map (FileOption "-I") (includeDirs rtsDetails) ++ + map Option md_c_flags) + 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 $ @@ -1374,7 +1409,7 @@ linkBinary dflags o_files dep_packages = do pkg_lib_paths <- getPackageLibraryPath dflags dep_packages let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths) -#ifdef linux_TARGET_OS +#ifdef elf_OBJ_FORMAT get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] | otherwise = ["-L" ++ l] #else @@ -1390,6 +1425,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 @@ -1428,7 +1477,7 @@ linkBinary dflags o_files dep_packages = do let thread_opts | WayThreaded `elem` ways = [ -#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) +#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) && !defined(haiku_TARGET_OS) "-lpthread" #endif #if defined(osf3_TARGET_OS) @@ -1464,6 +1513,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 @@ -1573,7 +1624,7 @@ linkDynLib dflags o_files dep_packages = do #endif let pkg_lib_paths = collectLibraryPaths pkgs_no_rts let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths -#ifdef linux_TARGET_OS +#ifdef elf_OBJ_FORMAT get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] | otherwise = ["-L" ++ l] #else @@ -1638,10 +1689,6 @@ linkDynLib dflags o_files dep_packages = do -- 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). - -- -Wl,-macosx_version_min -Wl,10.3 - -- Tell the linker its safe to assume that the library will run on 10.3 or - -- later, so that it will not complain about the use of the option - -- -undefined dynamic_lookup above. -- -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. @@ -1668,7 +1715,7 @@ linkDynLib dflags o_files dep_packages = do ++ map SysTools.Option ( md_c_flags ++ o_files - ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.5", + ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-read_only_relocs,suppress", "-install_name", instName ] ++ extra_ld_inputs ++ lib_path_opts @@ -1682,6 +1729,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 @@ -1691,7 +1746,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