X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=2b9cd4347faf41f776455764104782d7851a6648;hb=320738062c7a81f062c5adab98a1a1c4fdbd4bc7;hp=046e21ce5e2ebaf13117a6adad190e47c0ac4754;hpb=df1fecb95e3a0cf901184605da96dc8ae092b173;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 046e21c..2b9cd43 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -581,7 +581,9 @@ pipeLoop hsc_env phase stop_phase " but I wanted to stop at phase " ++ show stop_phase) | otherwise - = do (next_phase, dflags', maybe_loc, output_fn) + = do liftIO $ debugTraceMsg (hsc_dflags hsc_env) 4 + (ptext (sLit "Running phase") <+> ppr phase) + (next_phase, dflags', maybe_loc, output_fn) <- runPhase phase stop_phase hsc_env orig_basename orig_suff input_fn orig_get_output_fn maybe_loc let hsc_env' = hsc_env {hsc_dflags = dflags'} @@ -698,27 +700,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 + let dflags0' = flattenExtensionFlags dflags0 + src_opts <- liftIO $ getOptionsFromFile dflags0' input_fn (dflags1, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts checkProcessArgsResult unhandled_flags + let dflags1' = flattenExtensionFlags dflags1 - if not (dopt Opt_Cpp dflags1) then do + 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 + 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, dflags1, maybe_loc, input_fn) else do - output_fn <- liftIO $ get_output_fn dflags1 (HsPp sf) maybe_loc - liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-} input_fn 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 + src_opts <- liftIO $ getOptionsFromFile dflags0' output_fn (dflags2, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts - unless (dopt Opt_Pp dflags2) $ handleFlagWarnings dflags2 warns + let dflags2' = flattenExtensionFlags dflags2 + unless (dopt Opt_Pp dflags2') $ handleFlagWarnings dflags2' warns -- the HsPp pass below will emit warnings checkProcessArgsResult unhandled_flags @@ -729,10 +734,11 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc = do let dflags = hsc_dflags hsc_env + dflags' = flattenExtensionFlags dflags if not (dopt Opt_Pp dflags) then -- no need to preprocess, just pass input file along -- to the next phase of the pipeline. - return (Hsc sf, dflags, maybe_loc, input_fn) + return (Hsc sf, dflags', maybe_loc, input_fn) else do let hspp_opts = getOpts dflags opt_F let orig_fn = basename <.> suff @@ -746,13 +752,14 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc ) -- re-read pragmas now that we've parsed the file (see #3674) - src_opts <- liftIO $ getOptionsFromFile dflags output_fn + src_opts <- liftIO $ getOptionsFromFile dflags' output_fn (dflags1, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags src_opts - handleFlagWarnings dflags1 warns + let dflags1' = flattenExtensionFlags dflags1 + handleFlagWarnings dflags1' warns checkProcessArgsResult unhandled_flags - return (Hsc sf, dflags1, maybe_loc, output_fn) + return (Hsc sf, dflags1', maybe_loc, output_fn) ----------------------------------------------------------------------------- -- Hsc phase @@ -900,9 +907,10 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = do let dflags = hsc_dflags hsc_env - output_fn <- liftIO $ get_output_fn dflags Cmm maybe_loc - liftIO $ doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn - return (Cmm, dflags, maybe_loc, output_fn) + dflags' = flattenExtensionFlags dflags + output_fn <- liftIO $ get_output_fn dflags' Cmm maybe_loc + liftIO $ doCpp dflags' False{-not raw-} True{-include CC opts-} input_fn output_fn + return (Cmm, dflags', maybe_loc, output_fn) runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc = do @@ -1244,20 +1252,27 @@ runPhase LlvmOpt _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc let dflags = hsc_dflags hsc_env let lo_opts = getOpts dflags opt_lo let opt_lvl = max 0 (min 2 $ optLevel dflags) + -- don't specify anything if user has specified commands. We do this for + -- opt but not llc since opt is very specifically for optimisation passes + -- only, so if the user is passing us extra options we assume they know + -- what they are doing and don't get in the way. + let optFlag = if null lo_opts + then [SysTools.Option (llvmOpts !! opt_lvl)] + else [] output_fn <- get_output_fn dflags LlvmLlc maybe_loc SysTools.runLlvmOpt dflags - (map SysTools.Option lo_opts - ++ [ SysTools.FileOption "" input_fn, - SysTools.Option (llvmOpts !! opt_lvl), + ([ SysTools.FileOption "" input_fn, SysTools.Option "-o", - SysTools.FileOption "" output_fn]) + SysTools.FileOption "" output_fn] + ++ optFlag + ++ map SysTools.Option lo_opts) return (LlvmLlc, dflags, maybe_loc, output_fn) where - -- we always run Opt since we rely on it to fix up some pretty - -- big deficiencies in the code we generate + -- we always (unless -optlo specified) run Opt since we rely on it to + -- fix up some pretty big deficiencies in the code we generate llvmOpts = ["-mem2reg", "-O1", "-O2"] @@ -1278,15 +1293,18 @@ runPhase LlvmLlc _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc output_fn <- get_output_fn dflags nphase maybe_loc SysTools.runLlvmLlc dflags - (map SysTools.Option lc_opts - ++ [ -- SysTools.Option "-tailcallopt", - SysTools.Option (llvmOpts !! opt_lvl), + ([ SysTools.Option (llvmOpts !! opt_lvl), SysTools.FileOption "" input_fn, - SysTools.Option "-o", SysTools.FileOption "" output_fn]) + SysTools.Option "-o", SysTools.FileOption "" output_fn] + ++ map SysTools.Option lc_opts) return (nphase, dflags, maybe_loc, output_fn) where +#if darwin_TARGET_OS + llvmOpts = ["-O1", "-O2", "-O2"] +#else llvmOpts = ["-O1", "-O2", "-O3"] +#endif ----------------------------------------------------------------------------- @@ -1495,12 +1513,16 @@ 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 [] + let mkRtsEnabledObj val = do fn <- mkExtraCObj dflags + ["#include \"Rts.h\"", + "#include \"RtsOpts.h\"", + "const rtsOptsEnabledEnum rtsOptsEnabled = " + ++ val ++ ";"] + return [fn] + rtsEnabledObj <- case rtsOptsEnabled dflags of + RtsOptsNone -> mkRtsEnabledObj "rtsOptsNone" + RtsOptsSafeOnly -> return [] + RtsOptsAll -> mkRtsEnabledObj "rtsOptsAll" rtsOptsObj <- case rtsOpts dflags of Just opts -> do fn <- mkExtraCObj dflags