diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-02-10 19:46:50 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-16 04:35:22 -0500 |
commit | a01e78cc5badff447f4b242ef79f24ea8c9ff1cf (patch) | |
tree | 02723513b2fbdd431ca679b5b190e91c6afb0a49 | |
parent | 1109896c26d183df5fca0058191ea5a0e300e286 (diff) | |
download | haskell-a01e78cc5badff447f4b242ef79f24ea8c9ff1cf.tar.gz |
Don't build extra object with -no-hs-main
We don't need to compile/link an additional empty C file when it is not
needed.
This patch may also fix #18938 by avoiding trying to lookup the RTS unit
when there is none (yet) in the unit database.
-rw-r--r-- | compiler/GHC/Linker/ExtraObj.hs | 31 | ||||
-rw-r--r-- | compiler/GHC/Linker/Static.hs | 6 |
2 files changed, 25 insertions, 12 deletions
diff --git a/compiler/GHC/Linker/ExtraObj.hs b/compiler/GHC/Linker/ExtraObj.hs index 8e95f62d84..b8dca3e8dc 100644 --- a/compiler/GHC/Linker/ExtraObj.hs +++ b/compiler/GHC/Linker/ExtraObj.hs @@ -87,23 +87,34 @@ mkExtraObj logger dflags unit_state extn xs -- -- On Windows, when making a shared library we also may need a DllMain. -- -mkExtraObjToLinkIntoBinary :: Logger -> DynFlags -> UnitState -> IO FilePath +mkExtraObjToLinkIntoBinary :: Logger -> DynFlags -> UnitState -> IO (Maybe FilePath) mkExtraObjToLinkIntoBinary logger dflags unit_state = do when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ logInfo logger dflags $ withPprStyle defaultUserStyle (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$ text " Call hs_init_ghc() from your main() function to set these options.") - mkExtraObj logger dflags unit_state "c" (showSDoc dflags main) - where - main - | gopt Opt_NoHsMain dflags = Outputable.empty + case ghcLink dflags of + -- Don't try to build the extra object if it is not needed. Compiling the + -- extra object assumes the presence of the RTS in the unit database + -- (because the extra object imports Rts.h) but GHC's build system may try + -- to build some helper programs before building and registering the RTS! + -- See #18938 for an example where hp2ps failed to build because of a failed + -- (unsafe) lookup for the RTS in the unit db. + _ | gopt Opt_NoHsMain dflags + -> return Nothing + + LinkDynLib + | OSMinGW32 <- platformOS (targetPlatform dflags) + -> mk_extra_obj dllMain + | otherwise - = case ghcLink dflags of - LinkDynLib -> if platformOS (targetPlatform dflags) == OSMinGW32 - then dllMain - else Outputable.empty - _ -> exeMain + -> return Nothing + + _ -> mk_extra_obj exeMain + + where + mk_extra_obj = fmap Just . mkExtraObj logger dflags unit_state "c" . showSDoc dflags exeMain = vcat [ text "#include <Rts.h>", diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs index 84fbe41e7e..32640ddf62 100644 --- a/compiler/GHC/Linker/Static.hs +++ b/compiler/GHC/Linker/Static.hs @@ -35,6 +35,7 @@ import GHC.Driver.Session import System.FilePath import System.Directory import Control.Monad +import Data.Maybe ----------------------------------------------------------------------------- -- Static linking, of .o files @@ -137,7 +138,7 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do let lib_paths = libraryPaths dflags let lib_path_opts = map ("-L"++) lib_paths - extraLinkObj <- mkExtraObjToLinkIntoBinary logger dflags unit_state + extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger dflags unit_state noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger dflags unit_env dep_units let @@ -253,7 +254,8 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do rc_objs ++ framework_opts ++ pkg_lib_path_opts - ++ extraLinkObj:noteLinkObjs + ++ extraLinkObj + ++ noteLinkObjs ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin |