X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=9ac8fe4586db068bd0c5f125390af8c43a7be6e5;hb=2c77e092c3a6a5b936838afb7b338af70de2c689;hp=5253a2aa4f4d9223459447ef4e262ac755ce84dc;hpb=854afa17c0588b2b1a238a5c9e572bc9ad07bcf0;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 5253a2a..9ac8fe4 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -52,7 +52,7 @@ import MonadUtils import Data.Either import Exception -import Data.IORef ( readIORef, writeIORef, IORef ) +import Data.IORef ( readIORef ) import GHC.Exts ( Int(..) ) import System.Directory import System.FilePath @@ -260,11 +260,10 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) compileStub :: GhcMonad m => HscEnv -> Module -> ModLocation -> m FilePath compileStub hsc_env mod location = do - let (o_base, o_ext) = splitExtension (ml_obj_file location) - stub_o = (o_base ++ "_stub") <.> o_ext - -- compile the _stub.c file w/ gcc - let (stub_c,_,_) = mkStubPaths (hsc_dflags hsc_env) (moduleName mod) location + let (stub_c,_,stub_o) = mkStubPaths (hsc_dflags hsc_env) + (moduleName mod) location + runPipeline StopLn hsc_env (stub_c,Nothing) Nothing (SpecificFile stub_o) Nothing{-no ModLocation-} @@ -297,6 +296,26 @@ link NoLink _ _ _ = return Succeeded link LinkBinary dflags batch_attempt_linking hpt + = link' dflags batch_attempt_linking hpt + +link LinkDynLib dflags batch_attempt_linking hpt + = link' dflags batch_attempt_linking hpt + +#ifndef GHCI +-- warning suppression +link other _ _ _ = panicBadLink other +#endif + +panicBadLink :: GhcLink -> a +panicBadLink other = panic ("link: GHC not built to link this way: " ++ + show other) + +link' :: DynFlags -- dynamic flags + -> Bool -- attempt linking in batch mode? + -> HomePackageTable -- what to link + -> IO SuccessFlag + +link' dflags batch_attempt_linking hpt | batch_attempt_linking = do let @@ -348,13 +367,6 @@ link LinkBinary dflags batch_attempt_linking hpt text " Main.main not exported; not linking.") return Succeeded --- warning suppression -link other _ _ _ = panicBadLink other - -panicBadLink :: GhcLink -> a -panicBadLink other = panic ("link: GHC not built to link this way: " ++ - show other) - linkingNeeded :: DynFlags -> [Linkable] -> [PackageId] -> IO Bool linkingNeeded dflags linkables pkg_deps = do @@ -993,6 +1005,13 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- This is a temporary hack. ++ ["-mcpu=v9"] #endif +#if defined(darwin_TARGET_OS) && defined(i386_TARGET_ARCH) + -- By default, gcc on OS X will generate SSE + -- instructions, which need things 16-byte aligned, + -- but we don't 16-byte align things. Thus drop + -- back to generic i686 compatibility. Trac #2983. + ++ ["-march=i686"] +#endif ++ (if hcc && mangle then md_regd_c_flags else []) @@ -1068,13 +1087,13 @@ runPhase SplitMangle _stop hsc_env _basename _suff input_fn _get_output_fn maybe -- Save the number of split files for future references s <- readFile n_files_fn let n_files = read s :: Int - writeIORef v_Split_info (split_s_prefix, n_files) + dflags' = dflags { splitInfo = Just (split_s_prefix, n_files) } -- Remember to delete all these files - addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s" - | n <- [1..n_files]] + addFilesToClean dflags' [ split_s_prefix ++ "__" ++ show n ++ ".s" + | n <- [1..n_files]] - return (SplitAs, dflags, maybe_loc, "**splitmangle**") + return (SplitAs, dflags', maybe_loc, "**splitmangle**") -- we don't use the filename ----------------------------------------------------------------------------- @@ -1092,6 +1111,7 @@ runPhase As _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- might be a hierarchical module. createDirectoryHierarchy (takeDirectory output_fn) + let (md_c_flags, _) = machdepCCOpts dflags SysTools.runAs dflags (map SysTools.Option as_opts ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] @@ -1109,7 +1129,8 @@ runPhase As _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc , SysTools.FileOption "" input_fn , SysTools.Option "-o" , SysTools.FileOption "" output_fn - ]) + ] + ++ map SysTools.Option md_c_flags) return (StopLn, dflags, maybe_loc, output_fn) @@ -1132,20 +1153,34 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc let as_opts = getOpts dflags opt_a - (split_s_prefix, n) <- readIORef v_Split_info + let (split_s_prefix, n) = case splitInfo dflags of + Nothing -> panic "No split info" + Just x -> x let split_s n = split_s_prefix ++ "__" ++ show n <.> "s" split_obj n = split_odir takeFileName base_o ++ "__" ++ show n <.> osuf + let (md_c_flags, _) = machdepCCOpts dflags let assemble_file n = SysTools.runAs dflags (map SysTools.Option as_opts ++ +#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.Option "-o" , SysTools.FileOption "" (split_obj n) , SysTools.FileOption "" (split_s n) - ]) + ] + ++ map SysTools.Option md_c_flags) mapM_ assemble_file [1..n] @@ -1156,7 +1191,9 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc SysTools.Option "-Wl,-r", SysTools.Option ld_x_flag, SysTools.Option "-o", - SysTools.FileOption "" output_fn ] ++ args) + SysTools.FileOption "" output_fn ] + ++ map SysTools.Option md_c_flags + ++ args) ld_x_flag | null cLD_X = "" | otherwise = "-Wl,-x" @@ -1501,6 +1538,8 @@ maybeCreateManifest dflags exe_filename = do -- no FileOptions here: windres doesn't like seeing -- backslashes, apparently + removeFile manifest_filename + return [rc_obj_filename] #endif @@ -1726,5 +1765,3 @@ hscMaybeAdjustTarget dflags stop _ current_hsc_lang -- otherwise, stick to the plan | otherwise = current_hsc_lang -GLOBAL_VAR(v_Split_info, ("",0), (String,Int)) - -- The split prefix and number of files