diff options
Diffstat (limited to 'compiler/main/DriverPipeline.hs')
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 61 |
1 files changed, 33 insertions, 28 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 8c0f3a6098..8103f66239 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -172,8 +172,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) handleBatch (HscRecomp hasStub _) | isHsBoot src_flavour = do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too - liftIO $ SysTools.touch dflags' "Touching object file" - object_filename + liftIO $ touchObjectFile dflags' object_filename return maybe_old_linkable | otherwise @@ -956,7 +955,7 @@ runPhase (Hsc src_flavour) input_fn dflags0 case result of HscNoRecomp - -> do io $ SysTools.touch dflags' "Touching object file" o_file + -> do io $ touchObjectFile dflags' o_file -- The .o file must have a later modification date -- than the source file (else we wouldn't be in HscNoRecomp) -- but we touch it anyway, to keep 'make' happy (we think). @@ -970,7 +969,7 @@ runPhase (Hsc src_flavour) input_fn dflags0 -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make when (isHsBoot src_flavour) $ - io $ SysTools.touch dflags' "Touching object file" o_file + io $ touchObjectFile dflags' o_file return (next_phase, output_fn) ----------------------------------------------------------------------------- @@ -1437,25 +1436,39 @@ mkExtraCObj dflags xs ++ map (FileOption "-I") (includeDirs rtsDetails)) return oFile +-- When linking a binary, we need to create a C main() function that +-- starts everything off. This used to be compiled statically as part +-- of the RTS, but that made it hard to change the -rtsopts setting, +-- so now we generate and compile a main() stub as part of every +-- binary and pass the -rtsopts setting directly to the RTS (#5373) +-- mkExtraObjToLinkIntoBinary :: DynFlags -> [PackageId] -> IO FilePath mkExtraObjToLinkIntoBinary dflags dep_packages = do link_info <- getLinkInfo dflags dep_packages - mkExtraCObj dflags (showSDoc (vcat [rts_opts_enabled, - extra_rts_opts, + + mkExtraCObj dflags (showSDoc (vcat [main, link_opts link_info] <> char '\n')) -- final newline, to -- keep gcc happy where - rts_opts_enabled - = vcat [text "#include \"Rts.h\"", - text "#include \"RtsOpts.h\"", - text "const RtsOptsEnabledEnum rtsOptsEnabled = " <> - text (show (rtsOptsEnabled dflags)) <> semi ] - - extra_rts_opts = case rtsOpts dflags of - Nothing -> empty - Just opts -> text "char *ghc_rts_opts = " <> text (show opts) <> semi + main + | dopt Opt_NoHsMain dflags = empty + | otherwise = vcat [ + ptext (sLit "#include \"Rts.h\""), + ptext (sLit "extern StgClosure ZCMain_main_closure;"), + ptext (sLit "int main(int argc, char *argv[])"), + char '{', + ptext (sLit " RtsConfig __conf = defaultRtsConfig;"), + ptext (sLit " __conf.rts_opts_enabled = ") + <> text (show (rtsOptsEnabled dflags)) <> semi, + case rtsOpts dflags of + Nothing -> empty + Just opts -> ptext (sLit " __conf.rts_opts= ") <> + text (show opts) <> semi, + ptext (sLit " return hs_main(argc, argv, &ZCMain_main_closure,__conf);"), + char '}' + ] link_opts info | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags))) @@ -1607,13 +1620,6 @@ linkBinary dflags o_files dep_packages = do let lib_paths = libraryPaths dflags let lib_path_opts = map ("-L"++) lib_paths - -- The C "main" function is not in the rts but in a separate static - -- library libHSrtsmain.a that sits next to the rts lib files. Assuming - -- we're using a Haskell main function then we need to link it in. - let no_hs_main = dopt Opt_NoHsMain dflags - let main_lib | no_hs_main = [] - | otherwise = [ "-lHSrtsmain" ] - extraLinkObj <- mkExtraObjToLinkIntoBinary dflags dep_packages pkg_link_opts <- getPackageLinkOpts dflags dep_packages @@ -1731,7 +1737,6 @@ linkBinary dflags o_files dep_packages = do ++ framework_path_opts ++ framework_opts ++ pkg_lib_path_opts - ++ main_lib ++ [extraLinkObj] ++ pkg_link_opts ++ pkg_framework_path_opts @@ -1852,8 +1857,6 @@ linkDynLib dflags o_files dep_packages = do let extra_ld_opts = getOpts dflags opt_l - extraLinkObj <- mkExtraObjToLinkIntoBinary dflags dep_packages - #if defined(mingw32_HOST_OS) ----------------------------------------------------------------------------- -- Making a DLL @@ -1880,7 +1883,6 @@ linkDynLib dflags o_files dep_packages = do ++ lib_path_opts ++ extra_ld_opts ++ pkg_lib_path_opts - ++ [extraLinkObj] ++ pkg_link_opts )) #elif defined(darwin_TARGET_OS) @@ -1936,7 +1938,6 @@ linkDynLib dflags o_files dep_packages = do ++ lib_path_opts ++ extra_ld_opts ++ pkg_lib_path_opts - ++ [extraLinkObj] ++ pkg_link_opts )) #else @@ -1970,7 +1971,6 @@ linkDynLib dflags o_files dep_packages = do ++ lib_path_opts ++ extra_ld_opts ++ pkg_lib_path_opts - ++ [extraLinkObj] ++ pkg_link_opts )) #endif @@ -2083,3 +2083,8 @@ hscNextPhase dflags _ hsc_lang = HscNothing -> StopLn HscInterpreted -> StopLn +touchObjectFile :: DynFlags -> FilePath -> IO () +touchObjectFile dflags path = do + createDirectoryHierarchy $ takeDirectory path + SysTools.touch dflags "Touching object file" path + |