Add a class HasDynFlags(getDynFlags)
[ghc.git] / compiler / main / DriverPipeline.hs
index a832034..0e89907 100644 (file)
@@ -51,12 +51,10 @@ import SrcLoc
 import FastString
 import LlvmCodeGen      ( llvmFixupAsm )
 import MonadUtils
+import Platform
 
--- import Data.Either
 import Exception
 import Data.IORef       ( readIORef )
-import Distribution.System
--- import GHC.Exts              ( Int(..) )
 import System.Directory
 import System.FilePath
 import System.IO
@@ -103,6 +101,7 @@ compile :: HscEnv
         -> Int             -- ^ ... of M
         -> Maybe ModIface  -- ^ old interface, if we have one
         -> Maybe Linkable  -- ^ old linkable, if we have one
+        -> SourceModified
         -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful
 
 compile = compile' (hscCompileNothing, hscCompileInteractive, hscCompileBatch)
@@ -117,10 +116,12 @@ compile' ::
         -> Int             -- ^ ... of M
         -> Maybe ModIface  -- ^ old interface, if we have one
         -> Maybe Linkable  -- ^ old linkable, if we have one
+        -> SourceModified
         -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful
 
 compile' (nothingCompiler, interactiveCompiler, batchCompiler)
         hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
+        source_modified0
  = do
    let dflags0     = ms_hspp_opts summary
        this_mod    = ms_mod summary
@@ -136,9 +137,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
   -- We add the directory in which the .hs files resides) to the import path.
   -- This is needed when we try to compile the .hc file later, if it
   -- imports a _stub.h file that we created here.
-   let current_dir = case takeDirectory basename of
-                     "" -> "." -- XXX Hack
-                     d -> d
+   let current_dir = takeDirectory basename
        old_paths   = includePaths dflags0
        dflags      = dflags0 { includePaths = current_dir : old_paths }
        hsc_env     = hsc_env0 {hsc_dflags = dflags}
@@ -146,7 +145,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
    -- Figure out what lang we're generating
    let hsc_lang = hscTarget dflags
    -- ... and what the next phase should be
-   let next_phase = hscNextPhase dflags src_flavour hsc_lang
+   let next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
    -- ... and what file to generate the output into
    output_fn <- getOutputFilename next_phase
                         Temporary basename dflags next_phase (Just location)
@@ -158,7 +157,9 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
 
    -- -fforce-recomp should also work with --make
    let force_recomp = dopt Opt_ForceRecomp dflags
-       source_unchanged = isJust maybe_old_linkable && not force_recomp
+       source_modified
+         | force_recomp || isNothing maybe_old_linkable = SourceModified
+         | otherwise = source_modified0
        object_filename = ml_obj_file location
 
    let handleBatch HscNoRecomp
@@ -168,8 +169,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
        handleBatch (HscRecomp hasStub _)
            | isHsBoot src_flavour
                = do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too
-                       liftIO $ SysTools.touch dflags' "Touching object file"
-                                   object_filename
+                       liftIO $ touchObjectFile dflags' object_filename
                     return maybe_old_linkable
 
            | otherwise
@@ -225,7 +225,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
        --            -> m HomeModInfo
        runCompiler compiler handle
            = do (result, iface, details)
-                    <- compiler hsc_env' summary source_unchanged mb_old_iface
+                    <- compiler hsc_env' summary source_modified mb_old_iface
                                 (Just (mod_index, nmods))
                 linkable <- handle result
                 return (HomeModInfo{ hm_details  = details,
@@ -301,7 +301,7 @@ link' dflags batch_attempt_linking hpt
             home_mod_infos = eltsUFM hpt
 
             -- the packages we depend on
-            pkg_deps  = concatMap (dep_pkgs . mi_deps . hm_iface) home_mod_infos
+            pkg_deps  = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos
 
             -- the linkables to link
             linkables = map (expectJust "link".hm_linkable) home_mod_infos
@@ -326,8 +326,8 @@ link' dflags batch_attempt_linking hpt
                    return Succeeded
            else do
 
-        debugTraceMsg dflags 1 (ptext (sLit "Linking") <+> text exe_file
-                                 <+> text "...")
+        compilationProgressMsg dflags $ showSDoc $
+            (ptext (sLit "Linking") <+> text exe_file <+> text "...")
 
         -- Don't showPass in Batch mode; doLink will do that for us.
         let link = case ghcLink dflags of
@@ -386,7 +386,7 @@ linkingNeeded dflags linkables pkg_deps = do
 -- previous binary was linked with "the same options".
 checkLinkInfo :: DynFlags -> [PackageId] -> FilePath -> IO Bool
 checkLinkInfo dflags pkg_deps exe_file
- | isWindowsTarget || isDarwinTarget
+ | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
  -- ToDo: Windows and OS X do not use the ELF binary format, so
  -- readelf does not work there.  We need to find another way to do
  -- this.
@@ -401,6 +401,11 @@ checkLinkInfo dflags pkg_deps exe_file
    debugTraceMsg dflags 3 $ text ("Exe link info: " ++ show m_exe_link_info)
    return (Just link_info /= m_exe_link_info)
 
+platformSupportsSavingLinkOpts :: OS -> Bool
+platformSupportsSavingLinkOpts os
+  | os == OSSolaris2 = False -- see #5382
+  | otherwise        = osElfTarget os
+
 ghcLinkInfoSectionName :: String
 ghcLinkInfoSectionName = ".debug-ghc-link-info"
    -- if we use the ".debug" prefix, then strip will strip it by default
@@ -590,8 +595,8 @@ getPipeEnv = P $ \env state -> return (state, env)
 getPipeState :: CompPipeline PipeState
 getPipeState = P $ \_env state -> return (state, state)
 
-getDynFlags :: CompPipeline DynFlags
-getDynFlags = P $ \_env state -> return (state, hsc_dflags (hsc_env state))
+instance HasDynFlags CompPipeline where
+    getDynFlags = P $ \_env state -> return (state, hsc_dflags (hsc_env state))
 
 setDynFlags :: DynFlags -> CompPipeline ()
 setDynFlags dflags = P $ \_env state ->
@@ -737,9 +742,7 @@ runPhase (Unlit sf) input_fn dflags
                    [ -- The -h option passes the file name for unlit to
                      -- put in a #line directive
                      SysTools.Option     "-h"
-                     -- cpp interprets \b etc as escape sequences,
-                     -- so we use / for filenames in pragmas
-                   , SysTools.Option $ reslash Forwards $ normalise input_fn
+                   , SysTools.Option $ escape $ normalise input_fn
                    , SysTools.FileOption "" input_fn
                    , SysTools.FileOption "" output_fn
                    ]
@@ -747,6 +750,19 @@ runPhase (Unlit sf) input_fn dflags
        io $ SysTools.runUnlit dflags flags
 
        return (Cpp sf, output_fn)
+  where
+       -- escape the characters \, ", and ', but don't try to escape
+       -- Unicode or anything else (so we don't use Util.charToC
+       -- here).  If we get this wrong, then in
+       -- Coverage.addTicksToBinds where we check that the filename in
+       -- a SrcLoc is the same as the source filenaame, the two will
+       -- look bogusly different. See test:
+       -- libraries/hpc/tests/function/subdir/tough2.lhs
+       escape ('\\':cs) = '\\':'\\': escape cs
+       escape ('\"':cs) = '\\':'\"': escape cs
+       escape ('\'':cs) = '\\':'\'': escape cs
+       escape (c:cs)    = c : escape cs
+       escape []        = []
 
 -------------------------------------------------------------------------------
 -- Cpp phase : (a) gets OPTIONS out of file
@@ -756,7 +772,7 @@ runPhase (Cpp sf) input_fn dflags0
   = do
        src_opts <- io $ getOptionsFromFile dflags0 input_fn
        (dflags1, unhandled_flags, warns)
-           <- io $ parseDynamicNoPackageFlags dflags0 src_opts
+           <- io $ parseDynamicFilePragma dflags0 src_opts
        setDynFlags dflags1
        io $ checkProcessArgsResult unhandled_flags
 
@@ -774,7 +790,7 @@ runPhase (Cpp sf) input_fn dflags0
             -- See #2464,#3457
             src_opts <- io $ getOptionsFromFile dflags0 output_fn
             (dflags2, unhandled_flags, warns)
-                <- io $ parseDynamicNoPackageFlags dflags0 src_opts
+                <- io $ parseDynamicFilePragma dflags0 src_opts
             io $ checkProcessArgsResult unhandled_flags
             unless (dopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns
             -- the HsPp pass below will emit warnings
@@ -808,7 +824,7 @@ runPhase (HsPp sf) input_fn dflags
             -- re-read pragmas now that we've parsed the file (see #3674)
             src_opts <- io $ getOptionsFromFile dflags output_fn
             (dflags1, unhandled_flags, warns)
-                <- io $ parseDynamicNoPackageFlags dflags src_opts
+                <- io $ parseDynamicFilePragma dflags src_opts
             setDynFlags dflags1
             io $ checkProcessArgsResult unhandled_flags
             io $ handleFlagWarnings dflags1 warns
@@ -830,10 +846,7 @@ runPhase (Hsc src_flavour) input_fn dflags0
   -- we add the current directory (i.e. the directory in which
   -- the .hs files resides) to the include path, since this is
   -- what gcc does, and it's probably what you want.
-        let current_dir = case takeDirectory basename of
-                      "" -> "." -- XXX Hack
-                      d -> d
-
+        let current_dir = takeDirectory basename
             paths = includePaths dflags0
             dflags = dflags0 { includePaths = current_dir : paths }
 
@@ -895,25 +908,24 @@ runPhase (Hsc src_flavour) input_fn dflags0
   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
         src_timestamp <- io $ getModificationTime (basename <.> suff)
 
-        let force_recomp = dopt Opt_ForceRecomp dflags
-            hsc_lang = hscTarget dflags
+        let hsc_lang = hscTarget dflags
         source_unchanged <- io $
-          if force_recomp || not (isStopLn stop)
-                -- Set source_unchanged to False unconditionally if
+          if not (isStopLn stop)
+                -- SourceModified unconditionally if
                 --      (a) recompilation checker is off, or
                 --      (b) we aren't going all the way to .o file (e.g. ghc -S)
-             then return False
+             then return SourceModified
                 -- Otherwise look at file modification dates
              else do o_file_exists <- doesFileExist o_file
                      if not o_file_exists
-                        then return False       -- Need to recompile
+                        then return SourceModified       -- Need to recompile
                         else do t2 <- getModificationTime o_file
                                 if t2 > src_timestamp
-                                  then return True
-                                  else return False
+                                  then return SourceUnmodified
+                                  else return SourceModified
 
   -- get the DynFlags
-        let next_phase = hscNextPhase dflags src_flavour hsc_lang
+        let next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
         output_fn  <- phaseOutputFilename next_phase
 
         let dflags' = dflags { hscTarget = hsc_lang,
@@ -936,8 +948,8 @@ runPhase (Hsc src_flavour) input_fn dflags0
                                         ms_location  = location4,
                                         ms_hs_date   = src_timestamp,
                                         ms_obj_date  = Nothing,
-                                        ms_imps      = imps,
-                                        ms_srcimps   = src_imps }
+                                        ms_textual_imps = imps,
+                                        ms_srcimps      = src_imps }
 
   -- run the compiler!
         result <- io $ hscCompileOneShot hsc_env'
@@ -947,7 +959,7 @@ runPhase (Hsc src_flavour) input_fn dflags0
 
         case result of
           HscNoRecomp
-              -> do io $ SysTools.touch dflags' "Touching object file" o_file
+              -> do io $ touchObjectFile dflags' o_file
                     -- The .o file must have a later modification date
                     -- than the source file (else we wouldn't be in HscNoRecomp)
                     -- but we touch it anyway, to keep 'make' happy (we think).
@@ -961,7 +973,7 @@ runPhase (Hsc src_flavour) input_fn dflags0
                     -- In the case of hs-boot files, generate a dummy .o-boot
                     -- stamp file for the benefit of Make
                     when (isHsBoot src_flavour) $
-                      io $ SysTools.touch dflags' "Touching object file" o_file
+                      io $ touchObjectFile dflags' o_file
                     return (next_phase, output_fn)
 
 -----------------------------------------------------------------------------
@@ -979,7 +991,7 @@ runPhase Cmm input_fn dflags
         PipeEnv{src_basename} <- getPipeEnv
         let hsc_lang = hscTarget dflags
 
-        let next_phase = hscNextPhase dflags HsSrcFile hsc_lang
+        let next_phase = hscPostBackendPhase dflags HsSrcFile hsc_lang
 
         output_fn <- phaseOutputFilename next_phase
 
@@ -992,11 +1004,6 @@ runPhase Cmm input_fn dflags
 
         io $ hscCompileCmmFile hsc_env input_fn
 
-        -- XXX: catch errors above and convert them into ghcError?  Original
-        -- code was:
-        --
-        --when (not ok) $ ghcError (PhaseFailed "cmm" (ExitFailure 1))
-
         return (next_phase, output_fn)
 
 -----------------------------------------------------------------------------
@@ -1006,9 +1013,10 @@ runPhase Cmm input_fn dflags
 -- way too many hacks, and I can't say I've ever used it anyway.
 
 runPhase cc_phase input_fn dflags
-   | cc_phase `eqPhase` Cc || cc_phase `eqPhase` Ccpp || cc_phase `eqPhase` HCc || cc_phase `eqPhase` Cobjc
+   | any (cc_phase `eqPhase`) [Cc, Ccpp, HCc, Cobjc, Cobjcpp]
    = do
-        let cc_opts = getOpts dflags opt_c
+        let platform = targetPlatform dflags
+            cc_opts = getOpts dflags opt_c
             hcc = cc_phase `eqPhase` HCc
 
         let cmdline_include_paths = includePaths dflags
@@ -1036,12 +1044,15 @@ runPhase cc_phase input_fn dflags
              then return []
              else getPackageExtraCcOpts dflags pkgs
 
-#ifdef darwin_TARGET_OS
-        pkg_framework_paths <- io $ getPackageFrameworkPath dflags pkgs
-        let cmdline_framework_paths = frameworkPaths dflags
-        let framework_paths = map ("-F"++)
-                        (cmdline_framework_paths ++ pkg_framework_paths)
-#endif
+        framework_paths <-
+            case platformOS platform of
+            OSDarwin ->
+                do pkgFrameworkPaths <- io $ getPackageFrameworkPath dflags pkgs
+                   let cmdlineFrameworkPaths = frameworkPaths dflags
+                   return $ map ("-F"++)
+                                (cmdlineFrameworkPaths ++ pkgFrameworkPaths)
+            _ ->
+                return []
 
         let split_objs = dopt Opt_SplitObjs dflags
             split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
@@ -1051,7 +1062,6 @@ runPhase cc_phase input_fn dflags
                    | otherwise            = "-O"
 
         -- Decide next phase
-
         let next_phase = As
         output_fn <- phaseOutputFilename next_phase
 
@@ -1061,7 +1071,7 @@ runPhase cc_phase input_fn dflags
                 -- than a double, which leads to unpredictable results.
                 -- By default, we turn this off with -ffloat-store unless
                 -- the user specified -fexcess-precision.
-                (if cTargetArch == I386 &&
+                (if platformArch platform == ArchX86 &&
                     not (dopt Opt_ExcessPrecision dflags)
                         then [ "-ffloat-store" ]
                         else []) ++
@@ -1074,6 +1084,7 @@ runPhase cc_phase input_fn dflags
 
         let gcc_lang_opt | cc_phase `eqPhase` Ccpp  = "c++"
                          | cc_phase `eqPhase` Cobjc = "objective-c"
+                         | cc_phase `eqPhase` Cobjcpp = "objective-c++"
                          | otherwise                = "c"
         io $ SysTools.runCc dflags (
                 -- force the C compiler to interpret this file as C when
@@ -1093,7 +1104,7 @@ runPhase cc_phase input_fn dflags
                 -- These symbols are imported into the stub.c file via RtsAPI.h, and the
                 -- way we do the import depends on whether we're currently compiling
                 -- the base package or not.
-                       ++ (if cTargetOS == Windows &&
+                       ++ (if platformOS platform == OSMinGW32 &&
                               thisPackage dflags == basePackageId
                                 then [ "-DCOMPILING_BASE_PACKAGE" ]
                                 else [])
@@ -1104,7 +1115,7 @@ runPhase cc_phase input_fn dflags
         -- regardless of the ordering.
         --
         -- This is a temporary hack.
-                       ++ (if cTargetArch == Sparc
+                       ++ (if platformArch platform == ArchSPARC
                            then ["-mcpu=v9"]
                            else [])
 
@@ -1114,9 +1125,7 @@ runPhase cc_phase input_fn dflags
                        ++ verbFlags
                        ++ [ "-S", "-Wimplicit", cc_opt ]
                        ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
-#ifdef darwin_TARGET_OS
                        ++ framework_paths
-#endif
                        ++ cc_opts
                        ++ split_opt
                        ++ include_paths
@@ -1125,12 +1134,10 @@ runPhase cc_phase input_fn dflags
 
         return (next_phase, output_fn)
 
-        -- ToDo: postprocess the output from gcc
-
 -----------------------------------------------------------------------------
 -- Splitting phase
 
-runPhase SplitMangle input_fn dflags
+runPhase Splitter input_fn dflags
   = do  -- tmp_pfx is the prefix used for the split .s files
 
         split_s_prefix <- io $ SysTools.newTempName dflags "split"
@@ -1153,15 +1160,30 @@ runPhase SplitMangle input_fn dflags
         io $ addFilesToClean dflags' [ split_s_prefix ++ "__" ++ show n ++ ".s"
                                      | n <- [1..n_files]]
 
-        return (SplitAs, "**splitmangle**")
-          -- we don't use the filename
+        return (SplitAs,
+                "**splitter**") -- we don't use the filename in SplitAs
 
 -----------------------------------------------------------------------------
--- As phase
+-- As, SpitAs phase : Assembler
 
+-- This is for calling the assembler on a regular assembly file (not split).
 runPhase As input_fn dflags
   = do
-        let as_opts =  getOpts dflags opt_a
+        -- LLVM from version 3.0 onwards doesn't support the OS X system
+        -- assembler, so we use clang as the assembler instead. (#5636)
+        let whichAsProg | hscTarget dflags == HscLlvm &&
+                          platformOS (targetPlatform dflags) == OSDarwin
+                        = do
+                            llvmVer <- io $ figureLlvmVersion dflags
+                            return $ case llvmVer of
+                                Just n | n >= 30 -> SysTools.runClang
+                                _                -> SysTools.runAs
+
+                        | otherwise
+                        = return SysTools.runAs
+
+        as_prog <- whichAsProg
+        let as_opts = getOpts dflags opt_a
         let cmdline_include_paths = includePaths dflags
 
         next_phase <- maybeMergeStub
@@ -1171,7 +1193,7 @@ runPhase As input_fn dflags
         -- might be a hierarchical module.
         io $ createDirectoryHierarchy (takeDirectory output_fn)
 
-        io $ SysTools.runAs dflags
+        io $ as_prog dflags
                        (map SysTools.Option as_opts
                        ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
 
@@ -1182,7 +1204,7 @@ runPhase As input_fn dflags
         -- regardless of the ordering.
         --
         -- This is a temporary hack.
-                       ++ (if cTargetArch == Sparc
+                       ++ (if platformArch (targetPlatform dflags) == ArchSPARC
                            then [SysTools.Option "-mcpu=v9"]
                            else [])
 
@@ -1195,6 +1217,8 @@ runPhase As input_fn dflags
         return (next_phase, output_fn)
 
 
+-- This is for calling the assembler on a split assembly file (so a collection
+-- of assembly files)
 runPhase SplitAs _input_fn dflags
   = do
         -- we'll handle the stub_o file in this phase, so don't MergeStub,
@@ -1237,7 +1261,7 @@ runPhase SplitAs _input_fn dflags
         -- regardless of the ordering.
         --
         -- This is a temporary hack.
-                          (if cTargetArch == Sparc
+                          (if platformArch (targetPlatform dflags) == ArchSPARC
                            then [SysTools.Option "-mcpu=v9"]
                            else []) ++
 
@@ -1318,30 +1342,48 @@ runPhase LlvmLlc input_fn dflags
                | not opt_Static = "dynamic-no-pic"
                | otherwise      = "static"
 
-    output_fn <- phaseOutputFilename LlvmMangle
+    -- hidden debugging flag '-dno-llvm-mangler' to skip mangling
+    let next_phase = case dopt Opt_NoLlvmMangler dflags of
+                         False                            -> LlvmMangle
+                         True | dopt Opt_SplitObjs dflags -> Splitter
+                         True                             -> As
+                        
+    output_fn <- phaseOutputFilename next_phase
 
     io $ SysTools.runLlvmLlc dflags
                 ([ SysTools.Option (llvmOpts !! opt_lvl),
                     SysTools.Option $ "-relocation-model=" ++ rmodel,
                     SysTools.FileOption "" input_fn,
                     SysTools.Option "-o", SysTools.FileOption "" output_fn]
-                ++ map SysTools.Option lc_opts)
+                ++ map SysTools.Option lc_opts
+                ++ map SysTools.Option fpOpts)
 
-    return (LlvmMangle, output_fn)
+    return (next_phase, output_fn)
   where
         -- Bug in LLVM at O3 on OSX.
-        llvmOpts = if cTargetOS == OSX
+        llvmOpts = if platformOS (targetPlatform dflags) == OSDarwin
                    then ["-O1", "-O2", "-O2"]
                    else ["-O1", "-O2", "-O3"]
+        -- On ARMv7 using LLVM, LLVM fails to allocate floating point registers
+        -- while compiling GHC source code. It's probably due to fact that it
+        -- does not enable VFP by default. Let's do this manually here
+        fpOpts = case platformArch (targetPlatform dflags) of 
+                   ArchARM ARMv7 ext -> if (elem VFPv3 ext)
+                                      then ["-mattr=+v7,+vfp3"]
+                                      else if (elem VFPv3D16 ext)
+                                           then ["-mattr=+v7,+vfp3,+d16"]
+                                           else []
+                   _               -> []
 
 -----------------------------------------------------------------------------
 -- LlvmMangle phase
 
-runPhase LlvmMangle input_fn _dflags
+runPhase LlvmMangle input_fn dflags
   = do
-      output_fn <- phaseOutputFilename As
-      io $ llvmFixupAsm input_fn output_fn
-      return (As, output_fn)
+      let next_phase = if dopt Opt_SplitObjs dflags then Splitter else As
+      output_fn <- phaseOutputFilename next_phase
+      io $ llvmFixupAsm dflags input_fn output_fn
+      return (next_phase, output_fn)
 
 -----------------------------------------------------------------------------
 -- merge in stub objects
@@ -1408,41 +1450,63 @@ mkExtraCObj dflags xs
                      ([Option        "-c",
                        FileOption "" cFile,
                        Option        "-o",
-                       FileOption "" oFile] ++
-                      map (FileOption "-I") (includeDirs rtsDetails))
+                       FileOption "" oFile]
+                      ++ map SysTools.Option (getOpts dflags opt_c) -- see #5528
+                      ++ map (FileOption "-I") (includeDirs rtsDetails))
       return oFile
 
+-- When linking a binary, we need to create a C main() function that
+-- starts everything off.  This used to be compiled statically as part
+-- of the RTS, but that made it hard to change the -rtsopts setting,
+-- so now we generate and compile a main() stub as part of every
+-- binary and pass the -rtsopts setting directly to the RTS (#5373)
+--
 mkExtraObjToLinkIntoBinary :: DynFlags -> [PackageId] -> IO FilePath
 mkExtraObjToLinkIntoBinary dflags dep_packages = do
    link_info <- getLinkInfo dflags dep_packages
-   mkExtraCObj dflags (showSDoc (vcat [rts_opts_enabled,
-                                       extra_rts_opts,
+
+   let have_rts_opts_flags =
+         isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
+                                        RtsOptsSafeOnly -> False
+                                        _ -> True
+
+   when (dopt Opt_NoHsMain dflags && have_rts_opts_flags) $ do
+      hPutStrLn stderr $ "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main.\n" ++
+                         "    Call hs_init_ghc() from your main() function to set these options."
+
+   mkExtraCObj dflags (showSDoc (vcat [main,
                                        link_opts link_info]
                                    <> char '\n')) -- final newline, to
                                                   -- keep gcc happy
 
   where
-    mk_rts_opts_enabled val
-         = vcat [text "#include \"Rts.h\"",
-                 text "#include \"RtsOpts.h\"",
-                 text "const RtsOptsEnabledEnum rtsOptsEnabled = " <>
-                       text val <> semi ]
-
-    rts_opts_enabled = case rtsOptsEnabled dflags of
-          RtsOptsNone     -> mk_rts_opts_enabled "RtsOptsNone"
-          RtsOptsSafeOnly -> empty -- The default
-          RtsOptsAll      -> mk_rts_opts_enabled "RtsOptsAll"
-
-    extra_rts_opts = case rtsOpts dflags of
-          Nothing   -> empty
-          Just opts -> text "char *ghc_rts_opts = " <> text (show opts) <> semi
+    main
+      | dopt Opt_NoHsMain dflags = empty
+      | otherwise = vcat [
+             ptext (sLit "#include \"Rts.h\""),
+             ptext (sLit "extern StgClosure ZCMain_main_closure;"),
+             ptext (sLit "int main(int argc, char *argv[])"),
+             char '{',
+             ptext (sLit "    RtsConfig __conf = defaultRtsConfig;"),
+             ptext (sLit "    __conf.rts_opts_enabled = ")
+                 <> text (show (rtsOptsEnabled dflags)) <> semi,
+             case rtsOpts dflags of
+                Nothing   -> empty
+                Just opts -> ptext (sLit "    __conf.rts_opts= ") <>
+                               text (show opts) <> semi,
+             ptext (sLit "    return hs_main(argc, argv, &ZCMain_main_closure,__conf);"),
+             char '}'
+           ]
 
     link_opts info
-      | isDarwinTarget  = empty
-      | isWindowsTarget = empty
-      | otherwise = hcat [
+     | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
+     = empty
+     | otherwise = hcat [
           text "__asm__(\"\\t.section ", text ghcLinkInfoSectionName,
-                                    text ",\\\"\\\",@note\\n",
+                                    text ",\\\"\\\",",
+                                    text elfSectionNote,
+                                    text "\\n",
+
                     text "\\t.ascii \\\"", info', text "\\\"\\n\");" ]
           where
             -- we need to escape twice: once because we're inside a C string,
@@ -1452,6 +1516,11 @@ mkExtraObjToLinkIntoBinary dflags dep_packages = do
             escape :: String -> String
             escape = concatMap (charToC.fromIntegral.ord)
 
+            elfSectionNote :: String
+            elfSectionNote = case platformArch (targetPlatform dflags) of
+                               ArchARM _ _ -> "%note"
+                               _           -> "@note"
+
 -- The "link info" is a string representing the parameters of the
 -- link.  We save this information in the binary, and the next time we
 -- link, if nothing else has changed, we use the link info stored in
@@ -1459,15 +1528,13 @@ mkExtraObjToLinkIntoBinary dflags dep_packages = do
 getLinkInfo :: DynFlags -> [PackageId] -> IO String
 getLinkInfo dflags dep_packages = do
    package_link_opts <- getPackageLinkOpts dflags dep_packages
-#ifdef darwin_TARGET_OS
-   pkg_frameworks <- getPackageFrameworks dflags dep_packages
-#endif
+   pkg_frameworks <- case platformOS (targetPlatform dflags) of
+                     OSDarwin -> getPackageFrameworks dflags dep_packages
+                     _        -> return []
    extra_ld_inputs <- readIORef v_Ld_inputs
    let
       link_info = (package_link_opts,
-#ifdef darwin_TARGET_OS
                    pkg_frameworks,
-#endif
                    rtsOpts dflags,
                    rtsOptsEnabled dflags,
                    dopt Opt_NoHsMain dflags,
@@ -1561,7 +1628,8 @@ getHCFilePackages filename =
 
 linkBinary :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
 linkBinary dflags o_files dep_packages = do
-    let verbFlags = getVerbFlags dflags
+    let platform = targetPlatform dflags
+        verbFlags = getVerbFlags dflags
         output_fn = exeFileName dflags
 
     -- get the full list of packages to link with, by combining the
@@ -1570,41 +1638,54 @@ 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 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
-        get_pkg_lib_path_opts l = ["-L" ++ l]
-#endif
+        get_pkg_lib_path_opts l
+         | osElfTarget (platformOS platform) &&
+           dynLibLoader dflags == SystemDependent &&
+           not opt_Static
+            = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
+         | otherwise = ["-L" ++ l]
 
     let lib_paths = libraryPaths dflags
     let lib_path_opts = map ("-L"++) lib_paths
 
-    -- The C "main" function is not in the rts but in a separate static
-    -- library libHSrtsmain.a that sits next to the rts lib files. Assuming
-    -- we're using a Haskell main function then we need to link it in.
-    let no_hs_main = dopt Opt_NoHsMain dflags
-    let main_lib | no_hs_main = []
-                 | otherwise  = [ "-lHSrtsmain" ]
-
     extraLinkObj <- mkExtraObjToLinkIntoBinary dflags dep_packages
 
     pkg_link_opts <- getPackageLinkOpts dflags dep_packages
 
-#ifdef darwin_TARGET_OS
-    pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
-    let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths
+    pkg_framework_path_opts <-
+        case platformOS platform of
+        OSDarwin ->
+            do pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
+               return $ map ("-F" ++) pkg_framework_paths
+        _ ->
+            return []
+
+    framework_path_opts <-
+        case platformOS platform of
+        OSDarwin ->
+            do let framework_paths = frameworkPaths dflags
+               return $ map ("-F" ++) framework_paths
+        _ ->
+            return []
+
+    pkg_framework_opts <-
+        case platformOS platform of
+        OSDarwin ->
+            do pkg_frameworks <- getPackageFrameworks dflags dep_packages
+               return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
+        _ ->
+            return []
+
+    framework_opts <-
+        case platformOS platform of
+        OSDarwin ->
+            do let frameworks = cmdlineFrameworks dflags
+               -- reverse because they're added in reverse order from
+               -- the cmd line:
+               return $ concat [ ["-framework", fw] | fw <- reverse frameworks ]
+        _ ->
+            return []
 
-    let framework_paths = frameworkPaths dflags
-        framework_path_opts = map ("-F"++) framework_paths
-
-    pkg_frameworks <- getPackageFrameworks dflags dep_packages
-    let pkg_framework_opts = concat [ ["-framework", fw] | fw <- pkg_frameworks ]
-
-    let frameworks = cmdlineFrameworks dflags
-        framework_opts = concat [ ["-framework", fw] | fw <- reverse frameworks ]
-         -- reverse because they're added in reverse order from the cmd line
-#endif
         -- probably _stub.o files
     extra_ld_inputs <- readIORef v_Ld_inputs
 
@@ -1626,7 +1707,7 @@ linkBinary dflags o_files dep_packages = do
 
     let
         thread_opts | WayThreaded `elem` ways = [
-#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) && !defined(openbsd_TARGET_OS) && !defined(haiku_TARGET_OS)
+#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) && !defined(openbsd_TARGET_OS) && !defined(netbsd_TARGET_OS) && !defined(haiku_TARGET_OS)
                         "-lpthread"
 #endif
 #if defined(osf3_TARGET_OS)
@@ -1647,27 +1728,47 @@ linkBinary dflags o_files dep_packages = do
 
                       -- Permit the linker to auto link _symbol to _imp_symbol.
                       -- This lets us link against DLLs without needing an "import library".
-                      ++ (if cTargetOS == Windows
+                      ++ (if platformOS platform == OSMinGW32
                           then ["-Wl,--enable-auto-import"]
                           else [])
 
+                      -- '-no_compact_unwind'
+                      -- C++/Objective-C exceptions cannot use optimised
+                      -- stack unwinding code. The optimised form is the
+                      -- default in Xcode 4 on at least x86_64, and
+                      -- without this flag we're also seeing warnings
+                      -- like
+                      --     ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
+                      -- on x86.
+                      ++ (if cLdHasNoCompactUnwind == "YES"    &&
+                             platformOS   platform == OSDarwin &&
+                             platformArch platform `elem` [ArchX86, ArchX86_64]
+                          then ["-Wl,-no_compact_unwind"]
+                          else [])
+
+                      -- '-Wl,-read_only_relocs,suppress'
+                      -- ld gives loads of warnings like:
+                      --     ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure
+                      -- when linking any program. We're not sure
+                      -- whether this is something we ought to fix, but
+                      -- for now this flags silences them.
+                      ++ (if platformOS   platform == OSDarwin &&
+                             platformArch platform == ArchX86
+                          then ["-Wl,-read_only_relocs,suppress"]
+                          else [])
+
                       ++ o_files
                       ++ extra_ld_inputs
                       ++ lib_path_opts
                       ++ extra_ld_opts
                       ++ rc_objs
-#ifdef darwin_TARGET_OS
                       ++ framework_path_opts
                       ++ framework_opts
-#endif
                       ++ pkg_lib_path_opts
-                      ++ main_lib
                       ++ [extraLinkObj]
                       ++ pkg_link_opts
-#ifdef darwin_TARGET_OS
                       ++ pkg_framework_path_opts
                       ++ pkg_framework_opts
-#endif
                       ++ debug_opts
                       ++ thread_opts
                     ))
@@ -1681,13 +1782,13 @@ linkBinary dflags o_files dep_packages = do
 exeFileName :: DynFlags -> FilePath
 exeFileName dflags
   | Just s <- outputFile dflags =
-      if cTargetOS == Windows
+      if platformOS (targetPlatform dflags) == OSMinGW32
       then if null (takeExtension s)
            then s <.> "exe"
            else s
       else s
   | otherwise =
-      if cTargetOS == Windows
+      if platformOS (targetPlatform dflags) == OSMinGW32
       then "main.exe"
       else "a.out"
 
@@ -1695,58 +1796,55 @@ maybeCreateManifest
    :: DynFlags
    -> FilePath                          -- filename of executable
    -> IO [FilePath]                     -- extra objects to embed, maybe
-#ifndef mingw32_TARGET_OS
-maybeCreateManifest _ _ = do
-  return []
-#else
-maybeCreateManifest dflags exe_filename = do
-  if not (dopt Opt_GenManifest dflags) then return [] else do
-
-  let manifest_filename = exe_filename <.> "manifest"
-
-  writeFile manifest_filename $
-      "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
-      "  <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
-      "  <assemblyIdentity version=\"1.0.0.0\"\n"++
-      "     processorArchitecture=\"X86\"\n"++
-      "     name=\"" ++ dropExtension exe_filename ++ "\"\n"++
-      "     type=\"win32\"/>\n\n"++
-      "  <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
-      "    <security>\n"++
-      "      <requestedPrivileges>\n"++
-      "        <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n"++
-      "        </requestedPrivileges>\n"++
-      "       </security>\n"++
-      "  </trustInfo>\n"++
-      "</assembly>\n"
-
-  -- Windows will find the manifest file if it is named foo.exe.manifest.
-  -- However, for extra robustness, and so that we can move the binary around,
-  -- we can embed the manifest in the binary itself using windres:
-  if not (dopt Opt_EmbedManifest dflags) then return [] else do
-
-  rc_filename <- newTempName dflags "rc"
-  rc_obj_filename <- newTempName dflags (objectSuf dflags)
-
-  writeFile rc_filename $
-      "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
-        -- magic numbers :-)
-        -- show is a bit hackish above, but we need to escape the
-        -- backslashes in the path.
-
-  let wr_opts = getOpts dflags opt_windres
-  runWindres dflags $ map SysTools.Option $
-        ["--input="++rc_filename,
-         "--output="++rc_obj_filename,
-         "--output-format=coff"]
-        ++ wr_opts
-        -- no FileOptions here: windres doesn't like seeing
-        -- backslashes, apparently
-
-  removeFile manifest_filename
-
-  return [rc_obj_filename]
-#endif
+maybeCreateManifest dflags exe_filename
+ | platformOS (targetPlatform dflags) == OSMinGW32 &&
+   dopt Opt_GenManifest dflags
+    = do let manifest_filename = exe_filename <.> "manifest"
+
+         writeFile manifest_filename $
+             "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
+             "  <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
+             "  <assemblyIdentity version=\"1.0.0.0\"\n"++
+             "     processorArchitecture=\"X86\"\n"++
+             "     name=\"" ++ dropExtension exe_filename ++ "\"\n"++
+             "     type=\"win32\"/>\n\n"++
+             "  <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
+             "    <security>\n"++
+             "      <requestedPrivileges>\n"++
+             "        <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n"++
+             "        </requestedPrivileges>\n"++
+             "       </security>\n"++
+             "  </trustInfo>\n"++
+             "</assembly>\n"
+
+         -- Windows will find the manifest file if it is named
+         -- foo.exe.manifest. However, for extra robustness, and so that
+         -- we can move the binary around, we can embed the manifest in
+         -- the binary itself using windres:
+         if not (dopt Opt_EmbedManifest dflags) then return [] else do
+
+         rc_filename <- newTempName dflags "rc"
+         rc_obj_filename <- newTempName dflags (objectSuf dflags)
+
+         writeFile rc_filename $
+             "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
+               -- magic numbers :-)
+               -- show is a bit hackish above, but we need to escape the
+               -- backslashes in the path.
+
+         let wr_opts = getOpts dflags opt_windres
+         runWindres dflags $ map SysTools.Option $
+               ["--input="++rc_filename,
+                "--output="++rc_obj_filename,
+                "--output-format=coff"]
+               ++ wr_opts
+               -- no FileOptions here: windres doesn't like seeing
+               -- backslashes, apparently
+
+         removeFile manifest_filename
+
+         return [rc_obj_filename]
+ | otherwise = return []
 
 
 linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO ()
@@ -1758,12 +1856,12 @@ linkDynLib dflags o_files dep_packages = do
 
     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]
-                                | otherwise = ["-L" ++ l]
-#else
-        get_pkg_lib_path_opts l = ["-L" ++ l]
-#endif
+        get_pkg_lib_path_opts l
+         | osElfTarget (platformOS (targetPlatform dflags)) &&
+           dynLibLoader dflags == SystemDependent &&
+           not opt_Static
+            = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
+         | otherwise = ["-L" ++ l]
 
     let lib_paths = libraryPaths dflags
     let lib_path_opts = map ("-L"++) lib_paths
@@ -1775,11 +1873,11 @@ linkDynLib dflags o_files dep_packages = do
     -- 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 pkgs_no_rts = case platformOS (targetPlatform dflags) of
+                      OSMinGW32 ->
+                          pkgs
+                      _ ->
+                          filter ((/= rtsPackageId) . packageConfigId) pkgs
     let pkg_link_opts = collectLinkOpts dflags pkgs_no_rts
 
         -- probably _stub.o files
@@ -1787,8 +1885,6 @@ linkDynLib dflags o_files dep_packages = do
 
     let extra_ld_opts = getOpts dflags opt_l
 
-    extraLinkObj <- mkExtraObjToLinkIntoBinary dflags dep_packages
-
 #if defined(mingw32_HOST_OS)
     -----------------------------------------------------------------------------
     -- Making a DLL
@@ -1815,7 +1911,6 @@ linkDynLib dflags o_files dep_packages = do
          ++ lib_path_opts
          ++ extra_ld_opts
          ++ pkg_lib_path_opts
-         ++ [extraLinkObj]
          ++ pkg_link_opts
         ))
 #elif defined(darwin_TARGET_OS)
@@ -1871,7 +1966,6 @@ linkDynLib dflags o_files dep_packages = do
          ++ lib_path_opts
          ++ extra_ld_opts
          ++ pkg_lib_path_opts
-         ++ [extraLinkObj]
          ++ pkg_link_opts
         ))
 #else
@@ -1905,7 +1999,6 @@ linkDynLib dflags o_files dep_packages = do
          ++ lib_path_opts
          ++ extra_ld_opts
          ++ pkg_lib_path_opts
-         ++ [extraLinkObj]
          ++ pkg_link_opts
         ))
 #endif
@@ -1972,15 +2065,28 @@ joinObjectFiles dflags o_files output_fn = do
   let ld_r args = SysTools.runLink dflags ([
                             SysTools.Option "-nostdlib",
                             SysTools.Option "-nodefaultlibs",
-                            SysTools.Option "-Wl,-r",
+                            SysTools.Option "-Wl,-r"
+                            ]
+                            -- gcc on sparc sets -Wl,--relax implicitly, but
+                            -- -r and --relax are incompatible for ld, so
+                            -- disable --relax explicitly.
+                         ++ (if platformArch (targetPlatform dflags) == ArchSPARC
+                                then [SysTools.Option "-Wl,-no-relax"]
+                                else [])
+                         ++ [
                             SysTools.Option ld_build_id,
-                            SysTools.Option ld_x_flag,
+                            -- SysTools.Option ld_x_flag,
                             SysTools.Option "-o",
                             SysTools.FileOption "" output_fn ]
                          ++ args)
 
-      ld_x_flag | null cLD_X = ""
-                | otherwise  = "-Wl,-x"
+      -- Do *not* add the -x flag to ld, because we want to keep those
+      -- local symbols around for the benefit of external tools. e.g.
+      -- the 'perf report' output is much less useful if all the local
+      -- symbols have been stripped out.
+      --
+      -- ld_x_flag | null cLD_X = ""
+      --           | otherwise  = "-Wl,-x"
 
       -- suppress the generation of the .note.gnu.build-id section,
       -- which we don't need and sometimes causes ld to emit a
@@ -1999,15 +2105,20 @@ joinObjectFiles dflags o_files output_fn = do
 -- -----------------------------------------------------------------------------
 -- Misc.
 
-hscNextPhase :: DynFlags -> HscSource -> HscTarget -> Phase
-hscNextPhase _ HsBootFile _        =  StopLn
-hscNextPhase dflags _ hsc_lang =
+-- | What phase to run after one of the backend code generators has run
+hscPostBackendPhase :: DynFlags -> HscSource -> HscTarget -> Phase
+hscPostBackendPhase _ HsBootFile _    =  StopLn
+hscPostBackendPhase dflags _ hsc_lang =
   case hsc_lang of
         HscC -> HCc
-        HscAsm | dopt Opt_SplitObjs dflags -> SplitMangle
-               | otherwise -> As
+        HscAsm | dopt Opt_SplitObjs dflags -> Splitter
+               | otherwise                 -> As
         HscLlvm        -> LlvmOpt
         HscNothing     -> StopLn
         HscInterpreted -> StopLn
-        _other         -> StopLn
+
+touchObjectFile :: DynFlags -> FilePath -> IO ()
+touchObjectFile dflags path = do
+  createDirectoryHierarchy $ takeDirectory path
+  SysTools.touch dflags "Touching object file" path