import Packages
import HeaderInfo
import DriverPhases
-import SysTools ( newTempName, addFilesToClean, getSysMan, copy )
+import SysTools ( newTempName, addFilesToClean, copy )
import qualified SysTools
import HscMain
import Finder
import SrcLoc ( unLoc )
import SrcLoc ( Located(..) )
-import EXCEPTION
-import DATA_IOREF ( readIORef, writeIORef, IORef )
-import GLAEXTS ( Int(..) )
-
-import Directory
-import System
-import IO
-import Monad
+import Control.Exception as Exception
+import Data.IORef ( readIORef, writeIORef, IORef )
+import GHC.Exts ( Int(..) )
+import System.Directory
+import System.IO
+import SYSTEM_IO_ERROR as IO
+import Control.Monad
import Data.List ( isSuffixOf )
-import Maybe
-
+import Data.Maybe
+import System.Exit
+import System.Cmd
+import System.Environment
-- ---------------------------------------------------------------------------
-- Pre-process
extCoreName = basename ++ ".hcr" }
-- -no-recomp should also work with --make
- let do_recomp = dopt Opt_RecompChecking dflags
- source_unchanged = isJust maybe_old_linkable && do_recomp
+ let force_recomp = dopt Opt_ForceRecomp dflags
+ source_unchanged = isJust maybe_old_linkable && not force_recomp
hsc_env' = hsc_env { hsc_dflags = dflags' }
object_filename = ml_obj_file location
| Right t <- e_exe_time =
any (t <) (map linkableTime linkables)
- if dopt Opt_RecompChecking dflags && not linking_needed
+ if not (dopt Opt_ForceRecomp dflags) && not linking_needed
then do debugTraceMsg dflags 2 (text exe_file <+> ptext SLIT("is up to date, linking not required."))
return Succeeded
else do
let (basename, suffix) = splitFilename input_fn
-- If we were given a -x flag, then use that phase to start from
- start_phase
- | Just x_phase <- mb_phase = x_phase
- | otherwise = startPhase suffix
+ start_phase = fromMaybe (startPhase suffix) mb_phase
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
src_timestamp <- getModificationTime (basename `joinFileExt` suff)
- let do_recomp = dopt Opt_RecompChecking dflags
+ let force_recomp = dopt Opt_ForceRecomp dflags
source_unchanged <-
- if not do_recomp || not (isStopLn stop)
+ if force_recomp || not (isStopLn stop)
-- Set source_unchanged to False unconditionally if
-- (a) recompilation checker is off, or
-- (b) we aren't going all the way to .o file (e.g. ghc -S)
-- way too many hacks, and I can't say I've ever used it anyway.
runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
- | cc_phase `eqPhase` Cc || cc_phase `eqPhase` HCc
+ | cc_phase `eqPhase` Cc || cc_phase `eqPhase` Ccpp || cc_phase `eqPhase` HCc
= do let cc_opts = getOpts dflags opt_c
hcc = cc_phase `eqPhase` HCc
-- compiling .hc files, by adding the -x c option.
-- Also useful for plain .c files, just in case GHC saw a
-- -x c option.
- [ SysTools.Option "-x", SysTools.Option "c"] ++
+ [ SysTools.Option "-x", if cc_phase `eqPhase` Ccpp
+ then SysTools.Option "c++" else SysTools.Option "c"] ++
[ SysTools.FileOption "" input_fn
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
++ map SysTools.Option (
md_c_flags
++ pic_c_flags
+#ifdef sparc_TARGET_ARCH
+ -- We only support SparcV9 and better because V8 lacks an atomic CAS
+ -- instruction. Note that the user can still override this
+ -- (e.g., -mcpu=ultrasparc) as GCC picks the "best" -mcpu flag
+ -- regardless of the ordering.
+ --
+ -- This is a temporary hack.
+ ++ ["-mcpu=v9"]
+#endif
++ (if hcc && mangle
then md_regd_c_flags
else [])
++ split_opt
++ include_paths
++ pkg_extra_cc_opts
+#ifdef HAVE_GCC_HAS_WRAPV
+ -- We need consistent integer overflow (trac #952)
+ ++ ["-fwrapv"]
+#endif
))
return (next_phase, dflags, maybe_loc, output_fn)
SysTools.runAs dflags
(map SysTools.Option as_opts
++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
+#ifdef sparc_TARGET_ARCH
+ -- We only support SparcV9 and better because V8 lacks an atomic CAS
+ -- instruction so we have to make sure that the assembler accepts the
+ -- instruction set. Note that the user can still override this
+ -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag
+ -- regardless of the ordering.
+ --
+ -- This is a temporary hack.
+ ++ [ SysTools.Option "-mcpu=v9" ]
+#endif
++ [ SysTools.Option "-c"
, SysTools.FileOption "" input_fn
, SysTools.Option "-o"
-- 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 input_fn
+runPhase_MoveBinary dflags input_fn
= do
- sysMan <- getSysMan
+ let sysMan = pgm_sysman dflags
pvm_root <- getEnv "PVM_ROOT"
pvm_arch <- getEnv "PVM_ARCH"
let
getHCFilePackages :: FilePath -> IO [PackageId]
getHCFilePackages filename =
- EXCEPTION.bracket (openFile filename ReadMode) hClose $ \h -> do
+ Exception.bracket (openFile filename ReadMode) hClose $ \h -> do
l <- hGetLine h
case l of
'/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
-- parallel only: move binary to another dir -- HWL
when (WayPar `elem` ways)
- (do success <- runPhase_MoveBinary output_fn
+ (do success <- runPhase_MoveBinary dflags output_fn
if success then return ()
else throwDyn (InstallationError ("cannot move binary to PVM dir")))