X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverPipeline.hs;h=0db9de7d40f26d25d83a6c3aac764c72233529bd;hb=a3ccd83f8962827f8aa7e5169e1376dcb8cb12ea;hp=606e089aa0b8843fc6f0f28ce20478d2b17d07b4;hpb=17629712b35948e3751a39747dcc9ee0cbfb72aa;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 606e089..0db9de7 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,4 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.89 2001/07/11 19:48:07 sof Exp $ -- -- GHC Driver -- @@ -136,6 +135,7 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix) split <- readIORef v_Split_object_files mangle <- readIORef v_Do_asm_mangling keep_hc <- readIORef v_Keep_hc_files + keep_il <- readIORef v_Keep_il_files keep_raw_s <- readIORef v_Keep_raw_s_files keep_s <- readIORef v_Keep_s_files osuf <- readIORef v_Object_suf @@ -174,8 +174,11 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix) HscJava | split -> not_valid | otherwise -> error "not implemented: compiling via Java" +#ifdef ILX HscILX | split -> not_valid - | otherwise -> [ Unlit, Cpp, Hsc ] + | otherwise -> [ Unlit, Cpp, Hsc, Ilx2Il, Ilasm ] +#endif + HscNothing -> [ Unlit, Cpp, Hsc ] | cish = [ Cc, As ] @@ -186,6 +189,9 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix) stop_phase = case todo of StopBefore As | split -> SplitAs +#ifdef ILX + | real_lang == HscILX -> Ilasm +#endif StopBefore phase -> phase DoMkDependHS -> Ln DoLink -> Ln @@ -233,6 +239,9 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix) Mangle | keep_raw_s -> Persistent As | keep_s -> Persistent HCc | keep_hc -> Persistent +#ifdef ILX + Ilasm | keep_il -> Persistent +#endif _other -> Temporary -- add information about output files to the pipeline @@ -264,7 +273,7 @@ runPipeline pipeline (input_fn,suffix) do_linking use_ofile where (basename, _) = splitFilename input_fn pipeLoop [] input_fn _ _ _ _ = return input_fn -pipeLoop ((phase, keep, o_suffix):phases) +pipeLoop (all_phases@((phase, keep, o_suffix):phases)) (input_fn,real_suff) do_linking use_ofile orig_basename orig_suffix = do @@ -275,7 +284,7 @@ pipeLoop ((phase, keep, o_suffix):phases) -- checker has determined that recompilation isn't necessary. case mbCarryOn of Nothing -> do - let (_,keep,final_suffix) = last phases + let (_,keep,final_suffix) = last all_phases ofile <- outputFileName True keep final_suffix return (ofile, final_suffix) -- carry on ... @@ -324,7 +333,13 @@ run_phase :: Phase run_phase Unlit _basename _suff input_fn output_fn = do unlit_flags <- getOpts opt_L - SysTools.runUnlit (unlit_flags ++ ["-h", input_fn, input_fn, output_fn]) + -- The -h option passes the file name for unlit to put in a #line directive + SysTools.runUnlit (map SysTools.Option unlit_flags ++ + [ SysTools.Option "-h" + , SysTools.Option input_fn + , SysTools.FileOption "" input_fn + , SysTools.FileOption "" output_fn + ]) return (Just output_fn) ------------------------------------------------------------------------------- @@ -346,18 +361,23 @@ run_phase Cpp basename suff input_fn output_fn cmdline_include_paths <- readIORef v_Include_paths pkg_include_dirs <- getPackageIncludePath - let include_paths = map (\p -> "-I"++p) (cmdline_include_paths - ++ pkg_include_dirs) + let include_paths = foldr (\ x xs -> "-I" : x : xs) [] + (cmdline_include_paths ++ pkg_include_dirs) verb <- getVerbFlag (md_c_flags, _) <- machdepCCOpts - SysTools.runCpp ([verb] - ++ include_paths - ++ hs_src_cpp_opts - ++ hscpp_opts - ++ md_c_flags - ++ [ "-x", "c", input_fn, "-o", output_fn ]) + SysTools.runCpp ([SysTools.Option verb] + ++ map SysTools.Option include_paths + ++ map SysTools.Option hs_src_cpp_opts + ++ map SysTools.Option hscpp_opts + ++ map SysTools.Option md_c_flags + ++ [ SysTools.Option "-x" + , SysTools.Option "c" + , SysTools.FileOption "" input_fn + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ]) return (Just output_fn) ----------------------------------------------------------------------------- @@ -455,8 +475,8 @@ run_phase Hsc basename suff input_fn output_fn (srcimps,imps,mod_name) <- getImportsFromFile input_fn -- build a ModuleLocation to pass to hscMain. - Just (mod, location') - <- mkHomeModuleLocn mod_name basename (Just (basename ++ '.':suff)) + (mod, location') + <- mkHomeModuleLocn mod_name basename (basename ++ '.':suff) -- take -ohi into account if present ohi <- readIORef v_Output_hi @@ -497,7 +517,7 @@ run_phase Hsc basename suff input_fn output_fn let dyn_flags' = dyn_flags { hscOutName = output_fn, hscStubCOutName = basename ++ "_stub.c", hscStubHOutName = basename ++ "_stub.h", - extCoreName = basename ++ ".core" } + extCoreName = basename ++ ".hcr" } -- run the compiler! pcs <- initPersistentCompilerState @@ -521,13 +541,14 @@ run_phase Hsc basename suff input_fn output_fn HscRecomp pcs details iface stub_h_exists stub_c_exists _maybe_interpreted_code -> do - -- deal with stubs - maybe_stub_o <- compileStub dyn_flags' stub_c_exists - case maybe_stub_o of - Nothing -> return () - Just stub_o -> add v_Ld_inputs stub_o - - return (Just output_fn) + -- deal with stubs + maybe_stub_o <- compileStub dyn_flags' stub_c_exists + case maybe_stub_o of + Nothing -> return () + Just stub_o -> add v_Ld_inputs stub_o + case hscLang dyn_flags of + HscNothing -> return Nothing + _ -> return (Just output_fn) } ----------------------------------------------------------------------------- @@ -539,7 +560,7 @@ run_phase Hsc basename suff input_fn output_fn run_phase cc_phase basename suff input_fn output_fn | cc_phase == Cc || cc_phase == HCc = do cc_opts <- getOpts opt_c - cmdline_include_dirs <- readIORef v_Include_paths + cmdline_include_paths <- readIORef v_Include_paths let hcc = cc_phase == HCc @@ -547,8 +568,8 @@ run_phase cc_phase basename suff input_fn output_fn -- .c files; this is the Value Add(TM) that using -- ghc instead of gcc gives you :) pkg_include_dirs <- getPackageIncludePath - let include_paths = map (\p -> "-I"++p) (cmdline_include_dirs - ++ pkg_include_dirs) + let include_paths = foldr (\ x xs -> "-I" : x : xs) [] + (cmdline_include_paths ++ pkg_include_dirs) mangle <- readIORef v_Do_asm_mangling (md_c_flags, md_regd_c_flags) <- machdepCCOpts @@ -566,8 +587,13 @@ run_phase cc_phase basename suff input_fn output_fn | otherwise = [ ] excessPrecision <- readIORef v_Excess_precision - SysTools.runCc ([ "-x", "c", input_fn, "-o", output_fn ] - ++ md_c_flags + SysTools.runCc ([ SysTools.Option "-x", SysTools.Option "c" + , SysTools.FileOption "" input_fn + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ] + ++ map SysTools.Option ( + md_c_flags ++ (if cc_phase == HCc && mangle then md_regd_c_flags else []) @@ -578,7 +604,7 @@ run_phase cc_phase basename suff input_fn output_fn ++ (if excessPrecision then [] else [ "-ffloat-store" ]) ++ include_paths ++ pkg_extra_cc_opts - ) + )) return (Just output_fn) -- ToDo: postprocess the output from gcc @@ -593,9 +619,11 @@ run_phase Mangle _basename _suff input_fn output_fn return [ show n_regs ] else return [] - SysTools.runMangle (mangler_opts - ++ [ input_fn, output_fn ] - ++ machdep_opts) + SysTools.runMangle (map SysTools.Option mangler_opts + ++ [ SysTools.FileOption "" input_fn + , SysTools.FileOption "" output_fn + ] + ++ map SysTools.Option machdep_opts) return (Just output_fn) ----------------------------------------------------------------------------- @@ -607,7 +635,10 @@ run_phase SplitMangle _basename _suff input_fn output_fn split_s_prefix <- SysTools.newTempName "split" let n_files_fn = split_s_prefix - SysTools.runSplit [input_fn, split_s_prefix, n_files_fn] + SysTools.runSplit [ SysTools.FileOption "" input_fn + , SysTools.FileOption "" split_s_prefix + , SysTools.FileOption "" n_files_fn + ] -- Save the number of split files for future references s <- readFile n_files_fn @@ -627,9 +658,13 @@ run_phase As _basename _suff input_fn output_fn = do as_opts <- getOpts opt_a cmdline_include_paths <- readIORef v_Include_paths - SysTools.runAs (as_opts - ++ [ "-I" ++ p | p <- cmdline_include_paths ] - ++ [ "-c", input_fn, "-o", output_fn ]) + SysTools.runAs (map SysTools.Option as_opts + ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] + ++ [ SysTools.Option "-c" + , SysTools.FileOption "" input_fn + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ]) return (Just output_fn) run_phase SplitAs basename _suff _input_fn output_fn @@ -647,11 +682,46 @@ run_phase SplitAs basename _suff _input_fn output_fn let output_o = newdir real_odir (basename ++ "__" ++ show n ++ ".o") real_o <- osuf_ify output_o - SysTools.runAs (as_opts ++ ["-c", "-o", real_o, input_s]) + SysTools.runAs (map SysTools.Option as_opts ++ + [ SysTools.Option "-c" + , SysTools.Option "-o" + , SysTools.FileOption "" real_o + , SysTools.FileOption "" input_s + ]) mapM_ assemble_file [1..n] return (Just output_fn) +#ifdef ILX +----------------------------------------------------------------------------- +-- Ilx2Il phase +-- Run ilx2il over the ILX output, getting an IL file + +run_phase Ilx2Il _basename _suff input_fn output_fn + = do ilx2il_opts <- getOpts opt_I + SysTools.runIlx2il (map SysTools.Option ilx2il_opts + ++ [ SysTools.Option "--no-add-suffix-to-assembly", + SysTools.Option "mscorlib", + SysTools.Option "-o", + SysTools.FileOption "" output_fn, + SysTools.FileOption "" input_fn ]) + return (Just output_fn) + +----------------------------------------------------------------------------- +-- Ilasm phase +-- Run ilasm over the IL, getting a DLL + +run_phase Ilasm _basename _suff input_fn output_fn + = do ilasm_opts <- getOpts opt_i + SysTools.runIlasm (map SysTools.Option ilasm_opts + ++ [ SysTools.Option "/QUIET", + SysTools.Option "/DLL", + SysTools.FileOption "/OUT=" output_fn, + SysTools.FileOption "" input_fn ]) + return (Just output_fn) + +#endif -- ILX + ----------------------------------------------------------------------------- -- MoveBinary sort-of-phase -- After having produced a binary, move it somewhere else and generate a @@ -787,8 +857,12 @@ doLink o_files = do head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ] (md_c_flags, _) <- machdepCCOpts - SysTools.runLink ( [verb, "-o", output_fn] - ++ md_c_flags + SysTools.runLink ( [ SysTools.Option verb + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ] + ++ map SysTools.Option ( + md_c_flags ++ o_files ++ extra_os ++ extra_ld_inputs @@ -799,14 +873,9 @@ doLink o_files = do ++ pkg_extra_ld_opts ++ extra_ld_opts ++ if static && not no_hs_main then -#ifdef LEADING_UNDERSCORE - [ "-u _PrelMain_mainIO_closure" , - "-u ___init_PrelMain"] -#else - [ "-u PrelMain_mainIO_closure" , - "-u __init_PrelMain"] -#endif - else []) + [ "-u", prefixUnderscore "PrelMain_mainIO_closure", + "-u", prefixUnderscore "__stginit_PrelMain"] + else [])) -- parallel only: move binary to another dir -- HWL ways_ <- readIORef v_Ways @@ -859,8 +928,12 @@ doMkDLL o_files = do (md_c_flags, _) <- machdepCCOpts SysTools.runMkDLL - ([ verb, "-o", output_fn ] - ++ md_c_flags + ([ SysTools.Option verb + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ] + ++ map SysTools.Option ( + md_c_flags ++ o_files ++ extra_os ++ [ "--target=i386-mingw32" ] @@ -874,7 +947,7 @@ doMkDLL o_files = do Nothing -> [ "--export-all" ] Just _ -> [ "" ]) ++ extra_ld_opts - ) + )) ----------------------------------------------------------------------------- -- Just preprocess a file, put the result in a temp. file (used by the @@ -949,17 +1022,28 @@ compile ghci_mode summary source_unchanged have_object let hsc_lang = hscLang dyn_flags (basename, _) = splitFilename input_fn - output_fn <- case hsc_lang of - HscAsm -> newTempName (phaseInputExt As) - HscC -> newTempName (phaseInputExt HCc) - HscJava -> newTempName "java" -- ToDo - HscILX -> return (basename ++ ".ilx") -- newTempName "ilx" -- ToDo - HscInterpreted -> return (error "no output file") + keep_hc <- readIORef v_Keep_hc_files + keep_il <- readIORef v_Keep_il_files + keep_s <- readIORef v_Keep_s_files + + output_fn <- + case hsc_lang of + HscAsm | keep_s -> return (basename ++ '.':phaseInputExt As) + | otherwise -> newTempName (phaseInputExt As) + HscC | keep_hc -> return (basename ++ '.':phaseInputExt HCc) + | otherwise -> newTempName (phaseInputExt HCc) + HscJava -> newTempName "java" -- ToDo +#ifdef ILX + HscILX | keep_il -> return (basename ++ '.':phaseInputExt Ilasm) + | otherwise -> newTempName (phaseInputExt Ilx2Il) +#endif + HscInterpreted -> return (error "no output file") + HscNothing -> return (error "no output file") let dyn_flags' = dyn_flags { hscOutName = output_fn, hscStubCOutName = basename ++ "_stub.c", hscStubHOutName = basename ++ "_stub.h", - extCoreName = basename ++ ".core" } + extCoreName = basename ++ ".hcr" } -- figure out which header files to #include in a generated .hc file c_includes <- getPackageCIncludes @@ -975,10 +1059,14 @@ compile ghci_mode summary source_unchanged have_object writeIORef v_HCHeader cc_injects + -- -no-recomp should also work with --make + do_recomp <- readIORef v_Recomp + let source_unchanged' = source_unchanged && do_recomp + -- run the compiler hsc_result <- hscMain ghci_mode dyn_flags' (ms_mod summary) location - source_unchanged have_object old_iface hst hit pcs + source_unchanged' have_object old_iface hst hit pcs case hsc_result of HscFail pcs -> return (CompErrs pcs) @@ -1001,8 +1089,10 @@ compile ghci_mode summary source_unchanged have_object -- as our "unlinked" object. HscInterpreted -> case maybe_interpreted_code of +#ifdef GHCI Just (bcos,itbl_env) -> do tm <- getClockTime return ([BCOs bcos itbl_env], tm) +#endif Nothing -> panic "compile: no interpreted code" -- we're in batch mode: finish the compilation pipeline.