Commit 7b0ff179 authored by Simon Marlow's avatar Simon Marlow

Merge _stub.o files into the main .o file (Fixes #3687 and #706)

Now GHC still generates the _stub.c files, but the object file is
automatically merged into the main .o file for a module.  This means
that build systems (including GHC's own) no longer need to worry about
looking for _stub.o files and including them when linking.

I had to do lots of refactoring in DriverPipeline to make this work;
now there's a monad to carry around all the information, and
everything is a lot tidier.

The _stub.c is now created as a temporary file and removed after
compilation (unless the -keep-tmp-files flag is on).
parent 0ce8f5e7
......@@ -30,6 +30,7 @@ import OldCmm ( RawCmm )
import HscTypes
import DynFlags
import Config
import SysTools
import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit )
import Outputable
......@@ -56,7 +57,7 @@ codeOutput :: DynFlags
-> ForeignStubs
-> [PackageId]
-> [RawCmm] -- Compiled C--
-> IO (Bool{-stub_h_exists-}, Bool{-stub_c_exists-})
-> IO (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-})
codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC
=
......@@ -212,18 +213,21 @@ outputJava dflags filenm mod tycons core_binds
\begin{code}
outputForeignStubs :: DynFlags -> Module -> ModLocation -> ForeignStubs
-> IO (Bool, -- Header file created
Bool) -- C file created
Maybe FilePath) -- C file created
outputForeignStubs dflags mod location stubs
= case stubs of
NoStubs -> do
= do
let stub_h = mkStubPaths dflags (moduleName mod) location
stub_c <- newTempName dflags "c"
case stubs of
NoStubs -> do
-- When compiling External Core files, may need to use stub
-- files from a previous compilation
stub_c_exists <- doesFileExist stub_c
stub_h_exists <- doesFileExist stub_h
return (stub_h_exists, stub_c_exists)
stub_h_exists <- doesFileExist stub_h
return (stub_h_exists, Nothing)
ForeignStubs h_code c_code -> do
let
ForeignStubs h_code c_code -> do
let
stub_c_output_d = pprCode CStyle c_code
stub_c_output_w = showSDoc stub_c_output_d
......@@ -266,10 +270,10 @@ outputForeignStubs dflags mod location stubs
-- isn't really HC code, so we need to define IN_STG_CODE==0 to
-- avoid the register variables etc. being enabled.
return (stub_h_file_exists, stub_c_file_exists)
where
(stub_c, stub_h, _) = mkStubPaths dflags (moduleName mod) location
return (stub_h_file_exists, if stub_c_file_exists
then Just stub_c
else Nothing )
where
cplusplus_hdr = "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
cplusplus_ftr = "#ifdef __cplusplus\n}\n#endif\n"
......
......@@ -84,6 +84,7 @@ data Phase
| LlvmMangle -- Fix up TNTC by processing assembly produced by LLVM
| CmmCpp -- pre-process Cmm source
| Cmm -- parse & compile Cmm code
| MergeStub -- merge in the stub object file
-- The final phase is a pseudo-phase that tells the pipeline to stop.
-- There is no runPhase case for it.
......@@ -118,6 +119,7 @@ eqPhase LlvmLlc LlvmLlc = True
eqPhase LlvmMangle LlvmMangle = True
eqPhase CmmCpp CmmCpp = True
eqPhase Cmm Cmm = True
eqPhase MergeStub MergeStub = True
eqPhase StopLn StopLn = True
eqPhase _ _ = False
......@@ -131,7 +133,7 @@ x `happensBefore` y = after_x `eqPhase` y || after_x `happensBefore` y
after_x = nextPhase x
nextPhase :: Phase -> Phase
-- A conservative approximation the next phase, used in happensBefore
-- A conservative approximation to the next phase, used in happensBefore
nextPhase (Unlit sf) = Cpp sf
nextPhase (Cpp sf) = HsPp sf
nextPhase (HsPp sf) = Hsc sf
......@@ -145,12 +147,13 @@ nextPhase LlvmLlc = LlvmMangle
nextPhase LlvmLlc = As
#endif
nextPhase LlvmMangle = As
nextPhase SplitAs = StopLn
nextPhase SplitAs = MergeStub
nextPhase Ccpp = As
nextPhase Cc = As
nextPhase CmmCpp = Cmm
nextPhase Cmm = HCc
nextPhase HCc = As
nextPhase MergeStub = StopLn
nextPhase StopLn = panic "nextPhase: nothing after StopLn"
-- the first compilation phase for a given file is determined
......@@ -204,6 +207,7 @@ phaseInputExt LlvmMangle = "lm_s"
phaseInputExt SplitAs = "split_s" -- not really generated
phaseInputExt CmmCpp = "cmm"
phaseInputExt Cmm = "cmmcpp"
phaseInputExt MergeStub = "o"
phaseInputExt StopLn = "o"
haskellish_src_suffixes, haskellish_suffixes, cish_suffixes,
......
This diff is collapsed.
......@@ -498,7 +498,7 @@ mkStubPaths
:: DynFlags
-> ModuleName
-> ModLocation
-> (FilePath,FilePath,FilePath)
-> FilePath
mkStubPaths dflags mod location
= let
......@@ -513,15 +513,8 @@ mkStubPaths dflags mod location
| otherwise = src_basename
stub_basename = stub_basename0 ++ "_stub"
obj = ml_obj_file location
osuf = objectSuf dflags
stub_obj_base = dropTail (length osuf + 1) obj ++ "_stub"
-- NB. not takeFileName, see #3093
in
(stub_basename <.> "c",
stub_basename <.> "h",
stub_obj_base <.> objectSuf dflags)
stub_basename <.> "h"
-- -----------------------------------------------------------------------------
-- findLinkable isn't related to the other stuff in here,
......@@ -538,12 +531,9 @@ findObjectLinkableMaybe mod locn
-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
findObjectLinkable mod obj_fn obj_time = do
let stub_fn = (dropExtension obj_fn ++ "_stub") <.> "o"
stub_exist <- doesFileExist stub_fn
if stub_exist
then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
else return (LM obj_time mod [DotO obj_fn])
findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])
-- We used to look for _stub.o files here, but that was a bug (#706)
-- Now GHC merges the stub.o into the main .o (#3687)
-- -----------------------------------------------------------------------------
-- Error messages
......
......@@ -250,8 +250,9 @@ load2 how_much mod_graph = do
mg = stable_mg ++ partial_mg
-- clean up between compilations
let cleanup = cleanTempFilesExcept dflags
(ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
let cleanup hsc_env = intermediateCleanTempFiles dflags
(flattenSCCs mg2_with_srcimps)
hsc_env
liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
2 (ppr mg))
......@@ -276,9 +277,10 @@ load2 how_much mod_graph = do
do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
-- Clean up after ourselves
liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
hsc_env1 <- getSession
liftIO $ intermediateCleanTempFiles dflags modsDone hsc_env1
-- Issue a warning for the confusing case where the user
-- Issue a warning for the confusing case where the user
-- said '-o foo' but we're not going to do any linking.
-- We attempt linking if either (a) one of the modules is
-- called Main, or (b) the user said -no-hs-main, indicating
......@@ -300,7 +302,6 @@ load2 how_much mod_graph = do
moduleNameString (moduleName main_mod) ++ " module.")
-- link everything together
hsc_env1 <- getSession
linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
loadFinish Succeeded linkresult
......@@ -325,7 +326,7 @@ load2 how_much mod_graph = do
(hsc_HPT hsc_env1)
-- Clean up after ourselves
liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
liftIO $ intermediateCleanTempFiles dflags mods_to_keep hsc_env1
-- there should be no Nothings where linkables should be, now
ASSERT(all (isJust.hm_linkable)
......@@ -363,11 +364,21 @@ discardProg hsc_env
hsc_IC = emptyInteractiveContext,
hsc_HPT = emptyHomePackageTable }
-- used to fish out the preprocess output files for the purposes of
-- cleaning up. The preprocessed file *might* be the same as the
-- source file, but that doesn't do any harm.
ppFilesFromSummaries :: [ModSummary] -> [FilePath]
ppFilesFromSummaries summaries = map ms_hspp_file summaries
intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO ()
intermediateCleanTempFiles dflags summaries hsc_env
= cleanTempFilesExcept dflags except
where
except =
-- Save preprocessed files. The preprocessed file *might* be
-- the same as the source file, but that doesn't do any
-- harm.
map ms_hspp_file summaries ++
-- Save object files for loaded modules. The point of this
-- is that we might have generated and compiled a stub C
-- file, and in the case of GHCi the object file will be a
-- temporary file which we must not remove because we need
-- to load/link it later.
hptObjs (hsc_HPT hsc_env)
-- | If there is no -o option, guess the name of target executable
-- by using top-level source file name as a base.
......@@ -591,7 +602,7 @@ upsweep
:: GhcMonad m
=> HomePackageTable -- ^ HPT from last time round (pruned)
-> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
-> IO () -- ^ How to clean up unwanted tmp files
-> (HscEnv -> IO ()) -- ^ How to clean up unwanted tmp files
-> [SCC ModSummary] -- ^ Mods to do (the worklist)
-> m (SuccessFlag,
[ModSummary])
......@@ -624,6 +635,10 @@ upsweep old_hpt stable_mods cleanup sccs = do
let logger _mod = defaultWarnErrLogger
hsc_env <- getSession
-- Remove unwanted tmp files between compilations
liftIO (cleanup hsc_env)
mb_mod_info
<- handleSourceError
(\err -> do logger mod (Just err); return Nothing) $ do
......@@ -632,8 +647,6 @@ upsweep old_hpt stable_mods cleanup sccs = do
logger mod Nothing -- log warnings
return (Just mod_info)
liftIO cleanup -- Remove unwanted tmp files between compilations
case mb_mod_info of
Nothing -> return (Failed, done)
Just mod_info -> do
......
......@@ -460,7 +460,8 @@ error. This is the only thing that isn't caught by the type-system.
data HscStatus' a
= HscNoRecomp
| HscRecomp
Bool -- Has stub files. This is a hack. We can't compile C files here
(Maybe FilePath)
-- Has stub files. This is a hack. We can't compile C files here
-- since it's done in DriverPipeline. For now we just return True
-- if we want the caller to compile them for us.
a
......@@ -596,14 +597,14 @@ hscOneShotCompiler =
, hscBackend = \ tc_result mod_summary mb_old_hash -> do
dflags <- getDynFlags
case hscTarget dflags of
HscNothing -> return (HscRecomp False ())
HscNothing -> return (HscRecomp Nothing ())
_otherw -> genericHscBackend hscOneShotCompiler
tc_result mod_summary mb_old_hash
, hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
(iface, changed, _) <- hscSimpleIface tc_result mb_old_iface
hscWriteIface iface changed mod_summary
return (HscRecomp False ())
return (HscRecomp Nothing ())
, hscGenOutput = \guts0 mod_summary mb_old_iface -> do
guts <- hscSimplify' guts0
......@@ -649,7 +650,7 @@ hscBatchCompiler =
, hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
(iface, changed, details) <- hscSimpleIface tc_result mb_old_iface
hscWriteIface iface changed mod_summary
return (HscRecomp False (), iface, details)
return (HscRecomp Nothing (), iface, details)
, hscGenOutput = \guts0 mod_summary mb_old_iface -> do
guts <- hscSimplify' guts0
......@@ -681,7 +682,7 @@ hscInteractiveCompiler =
, hscGenBootOutput = \tc_result _mod_summary mb_old_iface -> do
(iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
return (HscRecomp False Nothing, iface, details)
return (HscRecomp Nothing Nothing, iface, details)
, hscGenOutput = \guts0 mod_summary mb_old_iface -> do
guts <- hscSimplify' guts0
......@@ -710,7 +711,7 @@ hscNothingCompiler =
, hscBackend = \tc_result _mod_summary mb_old_iface -> do
handleWarnings
(iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
return (HscRecomp False (), iface, details)
return (HscRecomp Nothing (), iface, details)
, hscGenBootOutput = \_ _ _ ->
panic "hscCompileNothing: hscGenBootOutput should not be called"
......@@ -852,7 +853,7 @@ hscWriteIface iface no_change mod_summary
-- | Compile to hard-code.
hscGenHardCode :: CgGuts -> ModSummary
-> Hsc Bool -- ^ @True@ <=> stub.c exists
-> Hsc (Maybe FilePath) -- ^ @Just f@ <=> _stub.c is f
hscGenHardCode cgguts mod_summary
= do
hsc_env <- getHscEnv
......
......@@ -25,8 +25,9 @@ module HscTypes (
-- * State relating to modules in this package
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
hptInstances, hptRules, hptVectInfo,
hptInstances, hptRules, hptVectInfo,
hptObjs,
-- * State relating to known packages
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
......@@ -76,7 +77,7 @@ module HscTypes (
Warnings(..), WarningTxt(..), plusWarns,
-- * Linker stuff
Linkable(..), isObjectLinkable,
Linkable(..), isObjectLinkable, linkableObjs,
Unlinked(..), CompiledByteCode,
isObject, nameOfObject, isInterpretable, byteCodeOfObject,
......@@ -494,6 +495,9 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
-- And get its dfuns
, thing <- things ]
hptObjs :: HomePackageTable -> [FilePath]
hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
\end{code}
%************************************************************************
......@@ -1790,6 +1794,9 @@ isObjectLinkable l = not (null unlinked) && all isObject unlinked
-- compiling a module in HscNothing mode, and this choice
-- happens to work well with checkStability in module GHC.
linkableObjs :: Linkable -> [FilePath]
linkableObjs l = [ f | DotO f <- linkableUnlinked l ]
instance Outputable Linkable where
ppr (LM when_made mod unlinkeds)
= (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
......
......@@ -40,12 +40,7 @@ endif
# All the .a/.so library file dependencies for this library
$1_$2_$3_DEPS_LIBS=$$(foreach dep,$$($1_$2_DEPS),$$($$(dep)_$2_$3_LIB))
ifneq "$$(BootingFromHc)" "YES"
$1_$2_$3_MKSTUBOBJS = $$(FIND) $1/$2/build -name "*_stub.$$($3_osuf)" -print
# HACK ^^^ we tried to use $(wildcard), but apparently it fails due to
# make using cached directory contents, or something.
else
$1_$2_$3_MKSTUBOBJS = true
ifeq "$$(BootingFromHc)" "YES"
$1_$2_$3_C_OBJS += $$(shell $$(FIND) $1/$2/build -name "*_stub.c" -print | sed 's/c$$$$/o/')
endif
......@@ -70,7 +65,6 @@ ifeq "$3" "dyn"
ifeq "$$(HOSTPLATFORM)" "i386-unknown-mingw32"
$$($1_$2_$3_LIB) : $$($1_$2_$3_ALL_OBJS) $$(ALL_RTS_LIBS) $$($1_$2_$3_DEPS_LIBS)
"$$($1_$2_HC)" $$($1_$2_$3_ALL_OBJS) \
`$$($1_$2_$3_MKSTUBOBJS)` \
-shared -dynamic -dynload deploy \
$$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES)) \
-no-auto-link-packages $$(addprefix -package ,$$($1_$2_DEPS)) \
......@@ -78,7 +72,6 @@ $$($1_$2_$3_LIB) : $$($1_$2_$3_ALL_OBJS) $$(ALL_RTS_LIBS) $$($1_$2_$3_DEPS_LIBS)
else
$$($1_$2_$3_LIB) : $$($1_$2_$3_ALL_OBJS) $$(ALL_RTS_LIBS) $$($1_$2_$3_DEPS_LIBS)
"$$($1_$2_HC)" $$($1_$2_$3_ALL_OBJS) \
`$$($1_$2_$3_MKSTUBOBJS)` \
-shared -dynamic -dynload deploy \
-dylib-install-name $(ghclibdir)/`basename "$$@" | sed 's/^libHS//;s/[-]ghc.*//'`/`basename "$$@"` \
-no-auto-link-packages $$(addprefix -package ,$$($1_$2_DEPS)) \
......@@ -90,9 +83,9 @@ $$($1_$2_$3_LIB) : $$($1_$2_$3_ALL_OBJS)
"$$(RM)" $$(RM_OPTS) $$@ $$@.contents
ifeq "$$($1_$2_SplitObjs)" "YES"
$$(FIND) $$(patsubst %.$$($3_osuf),%_$$($3_osuf)_split,$$($1_$2_$3_HS_OBJS)) -name '*.$$($3_osuf)' -print >> $$@.contents
echo $$($1_$2_$3_NON_HS_OBJS) `$$($1_$2_$3_MKSTUBOBJS)` >> $$@.contents
echo $$($1_$2_$3_NON_HS_OBJS) >> $$@.contents
else
echo $$($1_$2_$3_ALL_OBJS) `$$($1_$2_$3_MKSTUBOBJS)` >> $$@.contents
echo $$($1_$2_$3_ALL_OBJS) >> $$@.contents
endif
ifeq "$$(ArSupportsAtFile)" "YES"
"$$(AR)" $$(AR_OPTS) $$(EXTRA_AR_ARGS) $$@ @$$@.contents
......@@ -121,7 +114,7 @@ BINDIST_LIBS += $$($1_$2_GHCI_LIB)
endif
endif
$$($1_$2_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
"$$(LD)" -r -o $$@ $$(EXTRA_LD_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) `$$($1_$2_$3_MKSTUBOBJS)` $$($1_$2_EXTRA_OBJS)
"$$(LD)" -r -o $$@ $$(EXTRA_LD_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES"
# Don't bother making ghci libs for bootstrapping packages
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment