diff options
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r-- | compiler/GHC/Driver/Phases.hs | 15 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 29 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 7 |
4 files changed, 38 insertions, 27 deletions
diff --git a/compiler/GHC/Driver/Phases.hs b/compiler/GHC/Driver/Phases.hs index 2b4e234d12..31a1e45361 100644 --- a/compiler/GHC/Driver/Phases.hs +++ b/compiler/GHC/Driver/Phases.hs @@ -66,19 +66,20 @@ import System.FilePath C compiler (opt.) | .hc or .c | -S | .s assembler | .s or .S | -c | .o linker | other | - | a.out + linker (merge objects) | other | - | .o -} -- Phases we can actually stop after -data StopPhase = StopPreprocess -- -E - | StopC -- -C - | StopAs -- -S - | NoStop -- -c +data StopPhase = StopPreprocess -- ^ @-E@ + | StopC -- ^ @-C@ + | StopAs -- ^ @-S@ + | NoStop -- ^ @-c@ stopPhaseToPhase :: StopPhase -> Phase stopPhaseToPhase StopPreprocess = anyHsc -stopPhaseToPhase StopC = HCc -stopPhaseToPhase StopAs = As False -stopPhaseToPhase NoStop = StopLn +stopPhaseToPhase StopC = HCc +stopPhaseToPhase StopAs = As False +stopPhaseToPhase NoStop = StopLn -- | Untyped Phase description data Phase diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 92782176b2..22bd9c3280 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -378,9 +378,10 @@ link ghcLink logger tmpfs hooks dflags unit_env batch_attempt_linking hpt = case linkHook hooks of Nothing -> case ghcLink of NoLink -> return Succeeded - LinkBinary -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt - LinkStaticLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt - LinkDynLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt + LinkBinary -> normal_link + LinkStaticLib -> normal_link + LinkDynLib -> normal_link + LinkMergedObj -> normal_link LinkInMemory | platformMisc_ghcWithInterpreter $ platformMisc dflags -> -- Not Linking...(demand linker will do the job) @@ -388,6 +389,8 @@ link ghcLink logger tmpfs hooks dflags unit_env batch_attempt_linking hpt = | otherwise -> panicBadLink LinkInMemory Just h -> h ghcLink dflags batch_attempt_linking hpt + where + normal_link = link' logger tmpfs dflags unit_env batch_attempt_linking hpt panicBadLink :: GhcLink -> a @@ -559,6 +562,11 @@ doLink hsc_env o_files = LinkBinary -> linkBinary logger tmpfs dflags unit_env o_files [] LinkStaticLib -> linkStaticLib logger dflags unit_env o_files [] LinkDynLib -> linkDynLibCheck logger tmpfs dflags unit_env o_files [] + LinkMergedObj + | Just out <- outputFile dflags + , let objs = [ f | FileOption _ f <- ldInputs dflags ] + -> joinObjectFiles hsc_env (o_files ++ objs) out + | otherwise -> panic "Output path must be specified for LinkMergedObj" other -> panicBadLink other ----------------------------------------------------------------------------- diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index ef311c64ff..2c371d17c9 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -165,10 +165,7 @@ runMergeForeign _pipe_env hsc_env input_fn foreign_os = do (tmpDir (hsc_dflags hsc_env)) TFL_CurrentModule "o" copyFile input_fn new_o - let dflags = hsc_dflags hsc_env - logger = hsc_logger hsc_env - let tmpfs = hsc_tmpfs hsc_env - joinObjectFiles logger tmpfs dflags (new_o : foreign_os) input_fn + joinObjectFiles hsc_env (new_o : foreign_os) input_fn return input_fn runLlvmLlcPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath @@ -1098,7 +1095,7 @@ enabled in the toolchain: We must enable bigobj output in a few places: - * When merging object files (GHC.Driver.Pipeline.joinObjectFiles) + * When merging object files (GHC.Driver.Pipeline.Execute.joinObjectFiles) * When assembling (GHC.Driver.Pipeline.runPhase (RealPhase As ...)) @@ -1123,19 +1120,12 @@ via gcc. -} -joinObjectFiles :: Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO () -joinObjectFiles logger tmpfs dflags o_files output_fn = do +joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO () +joinObjectFiles hsc_env o_files output_fn = do let toolSettings' = toolSettings dflags ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' - osInfo = platformOS (targetPlatform dflags) - ld_r args = GHC.SysTools.runMergeObjects logger tmpfs dflags ( - -- See Note [Produce big objects on Windows] - concat - [ [GHC.SysTools.Option "--oformat", GHC.SysTools.Option "pe-bigobj-x86-64"] - | OSMinGW32 == osInfo - , not $ target32Bit (targetPlatform dflags) - ] - ++ map GHC.SysTools.Option ld_build_id + ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) ( + map GHC.SysTools.Option ld_build_id ++ [ GHC.SysTools.Option "-o", GHC.SysTools.FileOption "" output_fn ] ++ args) @@ -1144,7 +1134,7 @@ joinObjectFiles logger tmpfs dflags o_files output_fn = do -- which we don't need and sometimes causes ld to emit a -- warning: ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"] - | otherwise = [] + | otherwise = [] if ldIsGnuLd then do @@ -1161,6 +1151,11 @@ joinObjectFiles logger tmpfs dflags o_files output_fn = do GHC.SysTools.FileOption "" filelist] else ld_r (map (GHC.SysTools.FileOption "") o_files) + where + dflags = hsc_dflags hsc_env + tmpfs = hsc_tmpfs hsc_env + logger = hsc_logger hsc_env + ----------------------------------------------------------------------------- -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 232740dfe4..33b27c2f9f 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -917,6 +917,7 @@ data GhcLink -- bytecode and object code). | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) | LinkStaticLib -- ^ Link objects into a static lib + | LinkMergedObj -- ^ Link objects into a merged "GHCi object" deriving (Eq, Show) isNoLink :: GhcLink -> Bool @@ -2174,6 +2175,8 @@ dynamic_flags_deps = [ (noArg (\d -> d { ghcLink=LinkDynLib })) , make_ord_flag defGhcFlag "staticlib" (noArg (\d -> setGeneralFlag' Opt_LinkRts (d { ghcLink=LinkStaticLib }))) + , make_ord_flag defGhcFlag "merge-objs" + (noArg (\d -> d { ghcLink=LinkMergedObj })) , make_ord_flag defGhcFlag "dynload" (hasArg parseDynLibLoaderMode) , make_ord_flag defGhcFlag "dylib-install-name" (hasArg setDylibInstallName) @@ -4665,6 +4668,10 @@ makeDynFlagsConsistent dflags = loop dflags{targetWays_ = addWay WayProf (targetWays_ dflags)} "Enabling -prof, because -fobject-code is enabled and GHCi is profiled" + | LinkMergedObj <- ghcLink dflags + , Nothing <- outputFile dflags + = pgmError "--output must be specified when using --merge-objs" + | otherwise = (dflags, []) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning |