diff options
author | Ben Gamari <ben@smart-cactus.org> | 2022-02-05 15:27:20 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2022-02-09 15:56:11 -0500 |
commit | 4726f30cbf3379b1d177e8d496366801b69fff96 (patch) | |
tree | cdf7ed4ae9f6963f518712ed030691b19d0f2af6 | |
parent | 52f46cb0eb2d02a5515a425aee48bd309e86a626 (diff) | |
download | haskell-4726f30cbf3379b1d177e8d496366801b69fff96.tar.gz |
Use static archives as an alternative to object merging
Unfortunately, `lld`'s COFF backend does not currently support object
merging. With ld.bfd having broken support for high image-load base
addresses, it's necessary to find an alternative. Here I introduce
support in the driver for generating static archives, which we use on
Windows instead of object merging.
-rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Linker/Types.hs | 5 |
3 files changed, 15 insertions, 8 deletions
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 56e188395e..677c36ce67 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -781,14 +781,12 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do Nothing -> return mlinkable Just o_fp -> do unlinked_time <- liftIO (liftIO getCurrentTime) - final_o <- use (T_MergeForeign pipe_env hsc_env o_fp fos) - let !linkable = LM unlinked_time - (ms_mod mod_sum) - [DotO final_o] + final_unlinked <- DotO <$> use (T_MergeForeign pipe_env hsc_env o_fp fos) + let !linkable = LM unlinked_time (ms_mod mod_sum) [final_unlinked] return (Just linkable) return (miface, final_linkable) -asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath +asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m ObjFile asPipeline use_cpp pipe_env hsc_env location input_fn = do use (T_As use_cpp pipe_env hsc_env location input_fn) diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 4fafb5c294..2cfd0df972 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -130,7 +130,7 @@ runPhase (T_Cmm pipe_env hsc_env input_fn) = do output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env Nothing mstub <- hscCompileCmmFile hsc_env input_fn output_fn stub_o <- mapM (compileStub hsc_env) mstub - let foreign_os = (maybeToList stub_o) + let foreign_os = maybeToList stub_o return (foreign_os, output_fn) runPhase (T_Cc phase pipe_env hsc_env input_fn) = runCcPhase phase pipe_env hsc_env input_fn @@ -1120,7 +1120,8 @@ via gcc. -} joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO () -joinObjectFiles hsc_env o_files output_fn = do +joinObjectFiles hsc_env o_files output_fn + | can_merge_objs = do let toolSettings' = toolSettings dflags ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) ( @@ -1150,7 +1151,12 @@ joinObjectFiles hsc_env o_files output_fn = do GHC.SysTools.FileOption "" filelist] else ld_r (map (GHC.SysTools.FileOption "") o_files) + + | otherwise = do + withAtomicRename output_fn $ \tmp_ar -> + liftIO $ runAr logger dflags Nothing $ map Option $ ["rc", tmp_ar] ++ o_files where + can_merge_objs = False -- XXX dflags = hsc_dflags hsc_env tmpfs = hsc_tmpfs hsc_env logger = hsc_logger hsc_env diff --git a/compiler/GHC/Linker/Types.hs b/compiler/GHC/Linker/Types.hs index 17bb46feb9..c5525a46f9 100644 --- a/compiler/GHC/Linker/Types.hs +++ b/compiler/GHC/Linker/Types.hs @@ -11,6 +11,7 @@ module GHC.Linker.Types , LoaderState (..) , uninitializedLoader , Linkable(..) + , ObjFile , Unlinked(..) , SptEntry(..) , isObjectLinkable @@ -116,9 +117,11 @@ instance Outputable Linkable where = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod) $$ nest 3 (ppr unlinkeds) +type ObjFile = FilePath + -- | Objects which have yet to be linked by the compiler data Unlinked - = DotO FilePath -- ^ An object file (.o) + = DotO ObjFile -- ^ An object file (.o) | DotA FilePath -- ^ Static archive file (.a) | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) | BCOs CompiledByteCode |