X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=2019836fabd1e3e73b62088ecf4d59f98a51b42d;hb=0e6ff027979263c36703f26da836a784fe1606a2;hp=9128538dd7468f1c0ab8f7a554bf5bc48188cff0;hpb=1148cb85d9fc73e5cf67c477a1e08fd994961e60;p=ghc-hetmet.git

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 9128538..2019836 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -48,6 +48,7 @@ import Maybes           ( expectJust )
 import ParserCoreUtils  ( getCoreModuleName )
 import SrcLoc
 import FastString
+import LlvmCodeGen      ( llvmFixupAsm )
 -- import MonadUtils
 
 -- import Data.Either
@@ -697,27 +698,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
 
@@ -728,10 +732,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
@@ -745,13 +750,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
@@ -899,9 +905,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
@@ -1247,11 +1254,11 @@ runPhase LlvmOpt _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
     output_fn <- get_output_fn dflags LlvmLlc maybe_loc
 
     SysTools.runLlvmOpt dflags
-               (map SysTools.Option lo_opts
-               ++ [ SysTools.FileOption "" input_fn,
+               ([ SysTools.FileOption "" input_fn,
                     SysTools.Option (llvmOpts !! opt_lvl),
                     SysTools.Option "-o",
-                    SysTools.FileOption "" output_fn])
+                    SysTools.FileOption "" output_fn]
+               ++ map SysTools.Option lo_opts)
 
     return (LlvmLlc, dflags, maybe_loc, output_fn)
   where 
@@ -1268,19 +1275,38 @@ runPhase LlvmLlc _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
     let dflags  = hsc_dflags hsc_env
     let lc_opts = getOpts dflags opt_lc
     let opt_lvl = max 0 (min 2 $ optLevel dflags)
+#if darwin_TARGET_OS
+    let nphase = LlvmMangle
+#else
+    let nphase = As
+#endif
 
-    output_fn <- get_output_fn dflags As 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 (As, dflags, maybe_loc, output_fn)
+    return (nphase, dflags, maybe_loc, output_fn)
   where
+#if darwin_TARGET_OS
+        llvmOpts = ["-O1", "-O2", "-O2"]
+#else
         llvmOpts = ["-O1", "-O2", "-O3"]
+#endif
+
+
+-----------------------------------------------------------------------------
+-- LlvmMangle phase
+
+runPhase LlvmMangle _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
+  = liftIO $ do
+    let dflags = hsc_dflags hsc_env
+    output_fn <- get_output_fn dflags As maybe_loc
+    llvmFixupAsm input_fn output_fn
+    return (As, dflags, maybe_loc, output_fn)
 
 
 -- warning suppression