X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverPipeline.hs;h=171cecf2a61d9f52c9999082300f90caa575da45;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=a8fa8cedeb6f123733732426993b392f8cb32edc;hpb=d8afca91db837cc59ae505d113210c655d68c7b6;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index a8fa8ce..171cecf 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -157,8 +157,6 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do let dflags' = dflags { hscTarget = hsc_lang, hscOutName = output_fn, - hscStubCOutName = basename ++ "_stub.c", - hscStubHOutName = basename ++ "_stub.h", extCoreName = basename ++ ".hcr" } -- -no-recomp should also work with --make @@ -192,7 +190,7 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do -> do stub_unlinked <- if stub_c_exists then do - stub_o <- compileStub dflags' object_filename + stub_o <- compileStub dflags' this_mod location return [ DotO stub_o ] else return [] @@ -235,8 +233,9 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do ----------------------------------------------------------------------------- -- stub .h and .c files (for foreign export support) --- The _stub.c file is derived from the haskell source file (but stored --- in hscStubCOutName in the dflags for some reason, probably historical). +-- The _stub.c file is derived from the haskell source file, possibly taking +-- into account the -stubdir option. +-- -- Consequently, we derive the _stub.o filename from the haskell object -- filename. -- @@ -250,12 +249,13 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do -- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want -- obj/A_stub.o. -compileStub dflags object_filename = do - let (o_base, o_ext) = splitFilename object_filename +compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath +compileStub dflags mod location = do + let (o_base, o_ext) = splitFilename (ml_obj_file location) stub_o = o_base ++ "_stub" `joinFileExt` o_ext -- compile the _stub.c file w/ gcc - let stub_c = hscStubCOutName dflags + let (stub_c,_) = mkStubPaths dflags mod location runPipeline StopLn dflags (stub_c,Nothing) (SpecificFile stub_o) Nothing{-no ModLocation-} @@ -330,7 +330,10 @@ link BatchCompile dflags batch_attempt_linking hpt <+> text "...") -- Don't showPass in Batch mode; doLink will do that for us. - staticLink dflags obj_files pkg_deps + let link = case ghcLink dflags of + MkDLL -> doMkDLL + StaticLink -> staticLink + link dflags obj_files pkg_deps debugTraceMsg dflags 3 (text "link: done") @@ -509,7 +512,7 @@ getOutputFilename dflags stop_phase output basename = func where hcsuf = hcSuf dflags - odir = outputDir dflags + odir = objectDir dflags osuf = objectSuf dflags keep_hc = dopt Opt_KeepHcFiles dflags keep_raw_s = dopt Opt_KeepRawSFiles dflags @@ -742,8 +745,6 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma let dflags' = dflags { hscTarget = hsc_lang, hscOutName = output_fn, - hscStubCOutName = basename ++ "_stub.c", - hscStubHOutName = basename ++ "_stub.h", extCoreName = basename ++ ".hcr" } hsc_env <- newHscEnv dflags' @@ -774,7 +775,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma _maybe_interpreted_code -> do when stub_c_exists $ do - stub_o <- compileStub dflags' o_file + stub_o <- compileStub dflags' mod_name location4 consIORef v_Ld_inputs stub_o -- In the case of hs-boot files, generate a dummy .o-boot @@ -802,8 +803,6 @@ runPhase Cmm stop dflags basename suff input_fn get_output_fn maybe_loc let dflags' = dflags { hscTarget = hsc_lang, hscOutName = output_fn, - hscStubCOutName = basename ++ "_stub.c", - hscStubHOutName = basename ++ "_stub.h", extCoreName = basename ++ ".hcr" } ok <- hscCmmFile dflags' input_fn @@ -856,6 +855,23 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc | otherwise = As output_fn <- get_output_fn next_phase maybe_loc + let + more_hcc_opts = +#if i386_TARGET_ARCH + -- on x86 the floating point regs have greater precision + -- than a double, which leads to unpredictable results. + -- By default, we turn this off with -ffloat-store unless + -- the user specified -fexcess-precision. + (if excessPrecision then [] else [ "-ffloat-store" ]) ++ +#endif + -- gcc's -fstrict-aliasing allows two accesses to memory + -- to be considered non-aliasing if they have different types. + -- This interacts badly with the C code we generate, which is + -- very weakly typed, being derived from C--. + ["-fno-strict-aliasing"] + + + SysTools.runCc dflags ( -- force the C compiler to interpret this file as C when -- compiling .hc files, by adding the -x c option. @@ -872,11 +888,13 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc ++ (if hcc && mangle then md_regd_c_flags else []) + ++ (if hcc + then more_hcc_opts + else []) ++ [ verb, "-S", "-Wimplicit", "-O" ] ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ] ++ cc_opts ++ split_opt - ++ (if excessPrecision then [] else [ "-ffloat-store" ]) ++ include_paths ++ pkg_extra_cc_opts )) @@ -969,7 +987,7 @@ runPhase SplitAs stop dflags basename _suff _input_fn get_output_fn maybe_loc (split_s_prefix, n) <- readIORef v_Split_info let real_odir - | Just d <- outputDir dflags = d + | Just d <- objectDir dflags = d | otherwise = basename ++ "_split" let assemble_file n @@ -1209,7 +1227,14 @@ staticLink dflags o_files dep_packages = do exeFileName :: DynFlags -> FilePath exeFileName dflags - | Just s <- outputFile dflags = s + | Just s <- outputFile dflags = +#if defined(mingw32_HOST_OS) + if null (suffixOf s) + then s `joinFileExt` "exe" + else s +#else + s +#endif | otherwise = #if defined(mingw32_HOST_OS) "main.exe" @@ -1371,9 +1396,9 @@ getOptionsFromSource file | otherwise -> return [] getOptionsFromStringBuffer :: StringBuffer -> FilePath -> [(Int,String)] -getOptionsFromStringBuffer buffer@(StringBuffer _ len# _) fn = +getOptionsFromStringBuffer buffer@(StringBuffer _ len _) fn = let - ls = lines (lexemeToString buffer (I# len#)) -- lazy, so it's ok + ls = lines (lexemeToString buffer len) -- lazy, so it's ok in look 1 ls where