diff options
72 files changed, 79 insertions, 989 deletions
diff --git a/.gitignore b/.gitignore index cb30cdc6cc..e4e5420faf 100644 --- a/.gitignore +++ b/.gitignore @@ -68,7 +68,6 @@ _darcs/ /driver/ghc/dist/ /driver/haddock/dist/ /driver/ghci/dist/ -/driver/split/dist/ /includes/dist-*/ /libffi/dist-install/ /libraries/*/dist-boot/ diff --git a/aclocal.m4 b/aclocal.m4 index 9d2390e840..1647119e03 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -476,7 +476,6 @@ AC_DEFUN([FP_SETTINGS], SettingsLdCommand="\$tooldir/${mingw_bin_prefix}ld.exe" SettingsArCommand="\$tooldir/${mingw_bin_prefix}ar.exe" SettingsRanlibCommand="\$tooldir/${mingw_bin_prefix}ranlib.exe" - SettingsPerlCommand='$tooldir/perl/perl.exe' SettingsDllWrapCommand="\$tooldir/${mingw_bin_prefix}dllwrap.exe" SettingsWindresCommand="\$tooldir/${mingw_bin_prefix}windres.exe" SettingsTouchCommand='$topdir/bin/touchy.exe' @@ -488,7 +487,6 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" SettingsArCommand="$(basename $ArCmd)" - SettingsPerlCommand="$(basename $PerlCmd)" SettingsDllWrapCommand="$(basename $DllWrapCmd)" SettingsWindresCommand="$(basename $WindresCmd)" SettingsTouchCommand='$topdir/bin/touchy.exe' @@ -499,7 +497,6 @@ AC_DEFUN([FP_SETTINGS], SettingsLdCommand="$LdCmd" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" - SettingsPerlCommand="$PerlCmd" if test -z "$DllWrapCmd" then SettingsDllWrapCommand="/bin/false" @@ -552,7 +549,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) - AC_SUBST(SettingsPerlCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) @@ -1327,22 +1323,6 @@ AC_DEFUN([FP_GCC_SUPPORTS_NO_PIE], rm -f conftest.c conftest.o conftest ]) -dnl Small feature test for perl version. Assumes PerlCmd -dnl contains path to perl binary. -dnl -dnl (Perl versions prior to v5.6 does not contain the string "v5"; -dnl instead they display version strings such as "version 5.005".) -dnl -AC_DEFUN([FPTOOLS_CHECK_PERL_VERSION], -[$PerlCmd -v >conftest.out 2>&1 - if grep "v5" conftest.out >/dev/null 2>&1; then - : - else - AC_MSG_ERROR([your version of perl probably won't work, try upgrading it.]) - fi -rm -fr conftest* -]) - # FP_CHECK_PROG(VARIABLE, PROG-TO-CHECK-FOR, # [VALUE-IF-NOT-FOUND], [PATH], [REJECT]) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 40b4e70aa0..73ca36c848 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -39,7 +39,6 @@ module CLabel ( mkAsmTempEndLabel, mkAsmTempDieLabel, - mkSplitMarkerLabel, mkDirty_MUT_VAR_Label, mkUpdInfoLabel, mkBHUpdInfoLabel, @@ -486,7 +485,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- See Note [Proc-point local block entry-point]. -- Constructing Cmm Labels -mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel, +mkDirty_MUT_VAR_Label, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -496,7 +495,6 @@ mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel, mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel, mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction -mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC") CmmInfo diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index ff63b555ac..6cdb14880a 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -39,7 +39,6 @@ import Id import IdInfo import RepType import DataCon -import Name import TyCon import Module import Outputable @@ -120,17 +119,14 @@ variable. -} cgTopBinding :: DynFlags -> CgStgTopBinding -> FCode () cgTopBinding dflags (StgTopLifted (StgNonRec id rhs)) - = do { id' <- maybeExternaliseId dflags id - ; let (info, fcode) = cgTopRhs dflags NonRecursive id' rhs + = do { let (info, fcode) = cgTopRhs dflags NonRecursive id rhs ; fcode - ; addBindC info -- Add the *un-externalised* Id to the envt, - -- so we find it when we look up occurrences + ; addBindC info } cgTopBinding dflags (StgTopLifted (StgRec pairs)) = do { let (bndrs, rhss) = unzip pairs - ; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs - ; let pairs' = zip bndrs' rhss + ; let pairs' = zip bndrs rhss r = unzipWith (cgTopRhs dflags Recursive) pairs' (infos, fcodes) = unzip r ; addBindsC infos @@ -138,16 +134,14 @@ cgTopBinding dflags (StgTopLifted (StgRec pairs)) } cgTopBinding dflags (StgTopStringLit id str) - = do { id' <- maybeExternaliseId dflags id - ; let label = mkBytesLabel (idName id') + = do { let label = mkBytesLabel (idName id) ; let (lit, decl) = mkByteStringCLit label str ; emitDecl decl - ; addBindC (litIdInfo dflags id' mkLFStringLit lit) + ; addBindC (litIdInfo dflags id mkLFStringLit lit) } cgTopRhs :: DynFlags -> RecFlag -> Id -> CgStgRhs -> (CgIdInfo, FCode ()) -- The Id is passed along for setting up a binding... - -- It's already been externalised if necessary cgTopRhs dflags _rec bndr (StgRhsCon _cc con args) = cgTopRhsCon dflags bndr con (assertNonVoidStgArgs args) @@ -226,25 +220,3 @@ cgDataCon data_con } -- The case continuation code expects a tagged pointer } - ---------------------------------------------------------------- --- Stuff to support splitting ---------------------------------------------------------------- - -maybeExternaliseId :: DynFlags -> Id -> FCode Id -maybeExternaliseId dflags id - | gopt Opt_SplitObjs dflags, -- See Note [Externalise when splitting] - -- in StgCmmMonad - isInternalName name = do { mod <- getModuleName - ; return (setIdName id (externalise mod)) } - | otherwise = return id - where - externalise mod = mkExternalName uniq mod new_occ loc - name = idName id - uniq = nameUnique name - new_occ = mkLocalOcc uniq (nameOccName name) - loc = nameSrcSpan name - -- We want to conjure up a name that can't clash with any - -- existing name. So we generate - -- Mod_$L243foo - -- where 243 is the unique. diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 7a2340ed5f..5ad2e98abc 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -758,19 +758,14 @@ cgIdApp fun_id args = do dflags <- getDynFlags fun_info <- getCgIdInfo fun_id self_loop_info <- getSelfLoop - let cg_fun_id = cg_id fun_info - -- NB: use (cg_id fun_info) instead of fun_id, because - -- the former may be externalised for -split-objs. - -- See Note [Externalise when splitting] in StgCmmMonad - - fun_arg = StgVarArg cg_fun_id - fun_name = idName cg_fun_id + let fun_arg = StgVarArg fun_id + fun_name = idName fun_id fun = idInfoToAmode fun_info lf_info = cg_lf fun_info n_args = length args v_args = length $ filter (isVoidTy . stgArgType) args node_points dflags = nodeMustPointToIt dflags lf_info - case getCallMethod dflags fun_name cg_fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of + case getCallMethod dflags fun_name fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of -- A value in WHNF, so we can just return it. ReturnIt | isVoidTy (idType fun_id) -> emitReturn [] diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 9ddd8a3985..b93e0ab6eb 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -174,20 +174,10 @@ type CgBindings = IdEnv CgIdInfo data CgIdInfo = CgIdInfo { cg_id :: Id -- Id that this is the info for - -- Can differ from the Id at occurrence sites by - -- virtue of being externalised, for splittable C - -- See Note [Externalise when splitting] , cg_lf :: LambdaFormInfo , cg_loc :: CgLoc -- CmmExpr for the *tagged* value } --- Note [Externalise when splitting] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- If we're splitting the object with -fsplit-objs, we need to --- externalise *all* the top-level names, and then make sure we only --- use the externalised one in any C label we use which refers to this --- name. - instance Outputable CgIdInfo where ppr (CgIdInfo { cg_id = id, cg_loc = loc }) = ppr id <+> text "-->" <+> ppr loc diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 6cfa43ac5c..64615a3c9b 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -92,8 +92,6 @@ else ifeq "$(INTEGER_LIBRARY)" "integer-simple" else ifneq "$(CLEANING)" "YES" $(error Unknown integer library) endif - @echo 'cSupportsSplitObjs :: String' >> $@ - @echo 'cSupportsSplitObjs = "$(SupportsSplitObjs)"' >> $@ @echo 'cGhcWithInterpreter :: String' >> $@ @echo 'cGhcWithInterpreter = "$(GhcWithInterpreter)"' >> $@ @echo 'cGhcWithNativeCodeGen :: String' >> $@ @@ -114,8 +112,6 @@ endif @echo 'cLeadingUnderscore = "$(LeadingUnderscore)"' >> $@ @echo 'cGHC_UNLIT_PGM :: String' >> $@ @echo 'cGHC_UNLIT_PGM = "$(utils/unlit_dist_PROG)"' >> $@ - @echo 'cGHC_SPLIT_PGM :: String' >> $@ - @echo 'cGHC_SPLIT_PGM = "$(driver/split_dist_PROG)"' >> $@ @echo 'cLibFFI :: Bool' >> $@ ifeq "$(UseLibFFIForAdjustors)" "YES" @echo 'cLibFFI = True' >> $@ @@ -421,9 +417,6 @@ compiler_PACKAGE = ghc # Don't do splitting for the GHC package, it takes too long and # there's not much benefit. -compiler_stage1_SplitObjs = NO -compiler_stage2_SplitObjs = NO -compiler_stage3_SplitObjs = NO compiler_stage1_SplitSections = NO compiler_stage2_SplitSections = NO compiler_stage3_SplitSections = NO diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index d923262987..12e12ca321 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -138,8 +138,6 @@ data Phase | Cobjc -- Compile Objective-C | Cobjcxx -- Compile Objective-C++ | HCc -- Haskellised C (as opposed to vanilla C) compilation - | Splitter -- Assembly file splitter (part of '-split-objs') - | SplitAs -- Assembler for split assembly files (part of '-split-objs') | As Bool -- Assembler for regular assembly files (Bool: with-cpp) | LlvmOpt -- Run LLVM opt tool over llvm assembly | LlvmLlc -- LLVM bitcode to native assembly @@ -173,8 +171,6 @@ eqPhase (Hsc _) (Hsc _) = True eqPhase Cc Cc = True eqPhase Cobjc Cobjc = True eqPhase HCc HCc = True -eqPhase Splitter Splitter = True -eqPhase SplitAs SplitAs = True eqPhase (As x) (As y) = x == y eqPhase LlvmOpt LlvmOpt = True eqPhase LlvmLlc LlvmLlc = True @@ -218,11 +214,9 @@ nextPhase dflags p Cpp sf -> HsPp sf HsPp sf -> Hsc sf Hsc _ -> maybeHCc - Splitter -> SplitAs LlvmOpt -> LlvmLlc LlvmLlc -> LlvmMangle LlvmMangle -> As False - SplitAs -> MergeForeign As _ -> MergeForeign Ccxx -> As False Cc -> As False @@ -257,7 +251,6 @@ startPhase "M" = Cobjcxx startPhase "mm" = Cobjcxx startPhase "cc" = Ccxx startPhase "cxx" = Ccxx -startPhase "split_s" = Splitter startPhase "s" = As False startPhase "S" = As True startPhase "ll" = LlvmOpt @@ -286,13 +279,11 @@ phaseInputExt Ccxx = "cpp" phaseInputExt Cobjc = "m" phaseInputExt Cobjcxx = "mm" phaseInputExt Cc = "c" -phaseInputExt Splitter = "split_s" phaseInputExt (As True) = "S" phaseInputExt (As False) = "s" phaseInputExt LlvmOpt = "ll" phaseInputExt LlvmLlc = "bc" phaseInputExt LlvmMangle = "lm_s" -phaseInputExt SplitAs = "split_s" phaseInputExt CmmCpp = "cmmcpp" phaseInputExt Cmm = "cmm" phaseInputExt MergeForeign = "o" diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 5fe2362973..04576e715c 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns #-} +{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns, MultiWayIf #-} {-# OPTIONS_GHC -fno-cse #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly @@ -70,7 +70,7 @@ import System.Directory import System.FilePath import System.IO import Control.Monad -import Data.List ( isInfixOf, isSuffixOf, intercalate ) +import Data.List ( isInfixOf, intercalate ) import Data.Maybe import Data.Version import Data.Either ( partitionEithers ) @@ -247,7 +247,7 @@ compileOne' m_tc_result mHscMessage src_flavour = ms_hsc_src summary mod_name = ms_mod_name summary - next_phase = hscPostBackendPhase dflags src_flavour hsc_lang + next_phase = hscPostBackendPhase src_flavour hsc_lang object_filename = ml_obj_file location -- #8180 - when using TemplateHaskell, switch on -dynamic-too so @@ -505,7 +505,6 @@ compileFile hsc_env stop_phase (src, mb_phase) = do let dflags = hsc_dflags hsc_env - split = gopt Opt_SplitObjs dflags mb_o_file = outputFile dflags ghc_link = ghcLink dflags -- Set by -c or -no-link @@ -522,11 +521,7 @@ compileFile hsc_env stop_phase (src, mb_phase) = do -- -o foo applies to the file we are compiling now | otherwise = Persistent - stop_phase' = case stop_phase of - As _ | split -> SplitAs - _ -> stop_phase - - ( _, out_file) <- runPipeline stop_phase' hsc_env + ( _, out_file) <- runPipeline stop_phase hsc_env (src, fmap RealPhase mb_phase) Nothing output Nothing{-no ModLocation-} [] return out_file @@ -1085,7 +1080,7 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do let o_file = ml_obj_file location -- The real object file hsc_lang = hscTarget dflags - next_phase = hscPostBackendPhase dflags src_flavour hsc_lang + next_phase = hscPostBackendPhase src_flavour hsc_lang case result of HscNotGeneratingCode -> @@ -1138,7 +1133,7 @@ runPhase (RealPhase Cmm) input_fn dflags = do let hsc_lang = hscTarget dflags - let next_phase = hscPostBackendPhase dflags HsSrcFile hsc_lang + let next_phase = hscPostBackendPhase HsSrcFile hsc_lang output_fn <- phaseOutputFilename next_phase @@ -1281,40 +1276,9 @@ runPhase (RealPhase cc_phase) input_fn dflags return (RealPhase next_phase, output_fn) ----------------------------------------------------------------------------- --- Splitting phase - -runPhase (RealPhase Splitter) input_fn dflags - = do -- tmp_pfx is the prefix used for the split .s files - - split_s_prefix <- - liftIO $ newTempName dflags TFL_CurrentModule "split" - let n_files_fn = split_s_prefix - - liftIO $ SysTools.runSplit dflags - [ SysTools.FileOption "" input_fn - , SysTools.FileOption "" split_s_prefix - , SysTools.FileOption "" n_files_fn - ] - - -- Save the number of split files for future references - s <- liftIO $ readFile n_files_fn - let n_files = read s :: Int - dflags' = dflags { splitInfo = Just (split_s_prefix, n_files) } - - setDynFlags dflags' - - -- Remember to delete all these files - liftIO $ addFilesToClean dflags' TFL_CurrentModule $ - [ split_s_prefix ++ "__" ++ show n ++ ".s" - | n <- [1..n_files]] - - return (RealPhase SplitAs, - "**splitter**") -- we don't use the filename in SplitAs - ------------------------------------------------------------------------------ -- As, SpitAs phase : Assembler --- This is for calling the assembler on a regular assembly file (not split). +-- This is for calling the assembler on a regular assembly file runPhase (RealPhase (As with_cpp)) input_fn dflags = do -- LLVM from version 3.0 onwards doesn't support the OS X system @@ -1379,96 +1343,6 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags return (RealPhase next_phase, output_fn) --- This is for calling the assembler on a split assembly file (so a collection --- of assembly files) -runPhase (RealPhase SplitAs) _input_fn dflags - = do - -- we'll handle the stub_o file in this phase, so don't MergeForeign, - -- just jump straight to StopLn afterwards. - let next_phase = StopLn - output_fn <- phaseOutputFilename next_phase - - let base_o = dropExtension output_fn - osuf = objectSuf dflags - split_odir = base_o ++ "_" ++ osuf ++ "_split" - - let pic_c_flags = picCCOpts dflags - - -- this also creates the hierarchy - liftIO $ createDirectoryIfMissing True split_odir - - -- remove M_split/ *.o, because we're going to archive M_split/ *.o - -- later and we don't want to pick up any old objects. - fs <- liftIO $ getDirectoryContents split_odir - liftIO $ mapM_ removeFile $ - map (split_odir </>) $ filter (osuf `isSuffixOf`) fs - - let (split_s_prefix, n) = case splitInfo dflags of - Nothing -> panic "No split info" - Just x -> x - - let split_s n = split_s_prefix ++ "__" ++ show n <.> "s" - - split_obj :: Int -> FilePath - split_obj n = split_odir </> - takeFileName base_o ++ "__" ++ show n <.> osuf - - let assemble_file n - = SysTools.runAs dflags ( - - -- We only support SparcV9 and better because V8 lacks an atomic CAS - -- instruction so we have to make sure that the assembler accepts the - -- instruction set. Note that the user can still override this - -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag - -- regardless of the ordering. - -- - -- This is a temporary hack. - (if platformArch (targetPlatform dflags) == ArchSPARC - then [SysTools.Option "-mcpu=v9"] - else []) ++ - - -- See Note [-fPIC for assembler] - map SysTools.Option pic_c_flags ++ - - [ SysTools.Option "-c" - , SysTools.Option "-o" - , SysTools.FileOption "" (split_obj n) - , SysTools.FileOption "" (split_s n) - ]) - - liftIO $ mapM_ assemble_file [1..n] - - -- Note [pipeline-split-init] - -- If we have a stub file -- which will be part of foreign_os -- - -- it may contain constructor - -- functions for initialisation of this module. We can't - -- simply leave the stub as a separate object file, because it - -- will never be linked in: nothing refers to it. We need to - -- ensure that if we ever refer to the data in this module - -- that needs initialisation, then we also pull in the - -- initialisation routine. - -- - -- To that end, we make a DANGEROUS ASSUMPTION here: the data - -- that needs to be initialised is all in the FIRST split - -- object. See Note [codegen-split-init]. - -- - -- We also merge in all the foreign objects since we're at it. - - PipeState{foreign_os} <- getPipeState - if null foreign_os - then return () - else liftIO $ do - tmp_split_1 <- newTempName dflags TFL_CurrentModule osuf - let split_1 = split_obj 1 - copyFile split_1 tmp_split_1 - removeFile split_1 - joinObjectFiles dflags (tmp_split_1 : foreign_os) split_1 - - -- join them into a single .o file - liftIO $ joinObjectFiles dflags (map split_obj [1..n]) output_fn - - return (RealPhase next_phase, output_fn) - ----------------------------------------------------------------------------- -- LlvmOpt phase runPhase (RealPhase LlvmOpt) input_fn dflags @@ -1510,13 +1384,10 @@ runPhase (RealPhase LlvmOpt) input_fn dflags runPhase (RealPhase LlvmLlc) input_fn dflags = do - next_phase <- if fastLlvmPipeline dflags - then maybeMergeForeign - -- hidden debugging flag '-dno-llvm-mangler' to skip mangling - else case gopt Opt_NoLlvmMangler dflags of - False -> return LlvmMangle - True | gopt Opt_SplitObjs dflags -> return Splitter - True -> return (As False) + next_phase <- if | fastLlvmPipeline dflags -> maybeMergeForeign + -- hidden debugging flag '-dno-llvm-mangler' to skip mangling + | gopt Opt_NoLlvmMangler dflags -> return (As False) + | otherwise -> return LlvmMangle output_fn <- phaseOutputFilename next_phase @@ -1588,7 +1459,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags runPhase (RealPhase LlvmMangle) input_fn dflags = do - let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As False + let next_phase = As False output_fn <- phaseOutputFilename next_phase liftIO $ llvmFixupAsm dflags input_fn output_fn return (RealPhase next_phase, output_fn) @@ -2271,14 +2142,13 @@ sourceModified dest_file src_timestamp = do return (t2 <= src_timestamp) -- | What phase to run after one of the backend code generators has run -hscPostBackendPhase :: DynFlags -> HscSource -> HscTarget -> Phase -hscPostBackendPhase _ HsBootFile _ = StopLn -hscPostBackendPhase _ HsigFile _ = StopLn -hscPostBackendPhase dflags _ hsc_lang = +hscPostBackendPhase :: HscSource -> HscTarget -> Phase +hscPostBackendPhase HsBootFile _ = StopLn +hscPostBackendPhase HsigFile _ = StopLn +hscPostBackendPhase _ hsc_lang = case hsc_lang of - HscC -> HCc - HscAsm | gopt Opt_SplitObjs dflags -> Splitter - | otherwise -> As False + HscC -> HCc + HscAsm -> As False HscLlvm -> LlvmOpt HscNothing -> StopLn HscInterpreted -> StopLn diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d29fa4a9f9..b3cfa4860e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -90,7 +90,7 @@ module DynFlags ( ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, versionedAppDir, extraGccViaCFlags, systemPackageConfig, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T, pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_i, opt_P_signature, @@ -526,7 +526,6 @@ data GeneralFlag | Opt_ExcessPrecision | Opt_EagerBlackHoling | Opt_NoHsMain - | Opt_SplitObjs | Opt_SplitSections | Opt_StgStats | Opt_HideAllPackages @@ -1322,7 +1321,6 @@ data Settings = Settings { sPgm_P :: (String,[Option]), sPgm_F :: String, sPgm_c :: (String,[Option]), - sPgm_s :: (String,[Option]), sPgm_a :: (String,[Option]), sPgm_l :: (String,[Option]), sPgm_dll :: (String,[Option]), @@ -1383,8 +1381,6 @@ pgm_F :: DynFlags -> String pgm_F dflags = sPgm_F (settings dflags) pgm_c :: DynFlags -> (String,[Option]) pgm_c dflags = sPgm_c (settings dflags) -pgm_s :: DynFlags -> (String,[Option]) -pgm_s dflags = sPgm_s (settings dflags) pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = sPgm_a (settings dflags) pgm_l :: DynFlags -> (String,[Option]) @@ -1746,13 +1742,10 @@ wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag] wayUnsetGeneralFlags _ (WayCustom {}) = [] wayUnsetGeneralFlags _ WayThreaded = [] wayUnsetGeneralFlags _ WayDebug = [] -wayUnsetGeneralFlags _ WayDyn = [-- There's no point splitting objects +wayUnsetGeneralFlags _ WayDyn = [-- There's no point splitting -- when we're going to be dynamically -- linking. Plus it breaks compilation -- on OSX x86. - Opt_SplitObjs, - -- If splitobjs wasn't useful for this, - -- assume sections aren't either. Opt_SplitSections] wayUnsetGeneralFlags _ WayProf = [] wayUnsetGeneralFlags _ WayEventLog = [] @@ -3015,7 +3008,7 @@ dynamic_flags_deps = [ -- (see Trac #15319) sGccSupportsNoPie = False}))) , make_ord_flag defFlag "pgms" - (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])}))) + (HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8")) , make_ord_flag defFlag "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])}))) , make_ord_flag defFlag "pgml" @@ -3056,9 +3049,7 @@ dynamic_flags_deps = [ alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s}))) , make_ord_flag defGhcFlag "split-objs" - (NoArg (if can_split - then setGeneralFlag Opt_SplitObjs - else addWarn "ignoring -split-objs")) + (NoArg $ addWarn "ignoring -split-objs") , make_ord_flag defGhcFlag "split-sections" (noArgM (\dflags -> do @@ -5588,12 +5579,6 @@ picPOpts dflags | otherwise = [] -- ----------------------------------------------------------------------------- --- Splitting - -can_split :: Bool -can_split = cSupportsSplitObjs == "YES" - --- ----------------------------------------------------------------------------- -- Compiler Info compilerInfo :: DynFlags -> [(String, String)] @@ -5615,7 +5600,7 @@ compilerInfo dflags ("Host platform", cHostPlatformString), ("Target platform", cTargetPlatformString), ("Have interpreter", cGhcWithInterpreter), - ("Object splitting supported", cSupportsSplitObjs), + ("Object splitting supported", showBool False), ("Have native code generator", cGhcWithNativeCodeGen), ("Support SMP", cGhcWithSMP), ("Tables next to code", cGhcEnableTablesNextToCode), diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index bb16ae361d..16c8db94d9 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1494,7 +1494,7 @@ doCodeGen hsc_env this_mod data_tycons -- we generate one SRT for the whole module. let pipeline_stream - | gopt Opt_SplitObjs dflags || gopt Opt_SplitSections dflags || + | gopt Opt_SplitSections dflags || osSubsectionsViaSymbols (platformOS (targetPlatform dflags)) = {-# SCC "cmmPipeline" #-} let run_pipeline us cmmgroup = do diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 9bbce19602..543dd9ce3b 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -139,7 +139,7 @@ initSysTools top_dir -- NB: top_dir is assumed to be in standard Unix -- format, '/' separated mtool_dir <- findToolDir top_dir - -- see Note [tooldir: How GHC finds mingw and perl on Windows] + -- see Note [tooldir: How GHC finds mingw on Windows] let installed :: FilePath -> FilePath installed file = top_dir </> file @@ -212,7 +212,6 @@ initSysTools top_dir ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" - perl_path <- getToolSetting "perl command" let pkgconfig_path = installed "package.conf.d" ghc_usage_msg_path = installed "ghc-usage.txt" @@ -222,9 +221,6 @@ initSysTools top_dir -- architecture-specific stuff is done when building Config.hs unlit_path = libexec cGHC_UNLIT_PGM - -- split is a Perl script - split_script = libexec cGHC_SPLIT_PGM - windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" @@ -234,15 +230,6 @@ initSysTools top_dir touch_path <- getToolSetting "touch command" - let -- On Win32 we don't want to rely on #!/bin/perl, so we prepend - -- a call to Perl to get the invocation of split. - -- On Unix, scripts are invoked using the '#!' method. Binary - -- installations of GHC on Unix place the correct line on the - -- front of the script at installation time, so we don't want - -- to wire-in our knowledge of $(PERL) on the host system here. - (split_prog, split_args) - | isWindowsHost = (perl_path, [Option split_script]) - | otherwise = (split_script, []) mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -297,7 +284,6 @@ initSysTools top_dir sPgm_P = (cpp_prog, cpp_args), sPgm_F = "", sPgm_c = (gcc_prog, gcc_args), - sPgm_s = (split_prog,split_args), sPgm_a = (as_prog, as_args), sPgm_l = (ld_prog, ld_args), sPgm_dll = (mkdll_prog,mkdll_args), diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index 786b0e4ee9..d01d5214b4 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -68,7 +68,7 @@ On Windows: from topdir we can find package.conf, ghc-asm, etc. -Note [tooldir: How GHC finds mingw and perl on Windows] +Note [tooldir: How GHC finds mingw on Windows] GHC has some custom logic on Windows for finding the mingw toolchain and perl. Depending on whether GHC is built diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/main/SysTools/Tasks.hs index a986db2fc0..9e3df26877 100644 --- a/compiler/main/SysTools/Tasks.hs +++ b/compiler/main/SysTools/Tasks.hs @@ -131,11 +131,6 @@ askLd dflags args = do runSomethingWith dflags "gcc" p args2 $ \real_args -> readCreateProcessWithExitCode' (proc p real_args){ env = mb_env } -runSplit :: DynFlags -> [Option] -> IO () -runSplit dflags args = do - let (p,args0) = pgm_s dflags - runSomething dflags "Splitter" p (args0++args) - runAs :: DynFlags -> [Option] -> IO () runAs dflags args = do let (p,args0) = pgm_a dflags diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 4672415ec5..b866741995 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -335,7 +335,7 @@ finishNativeGen :: Instruction instr finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs = do -- Write debug data and finish - let emitDw = debugLevel dflags > 0 && not (gopt Opt_SplitObjs dflags) + let emitDw = debugLevel dflags > 0 us' <- if not emitDw then return us else do (dwarf, us') <- dwarfGen dflags modLoc us (ngs_debug ngs) emitNativeCode dflags bufh dwarf @@ -406,14 +406,9 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs | otherwise = [] dbgMap = debugToMap ndbgs - -- Insert split marker, generate native code - let splitObjs = gopt Opt_SplitObjs dflags - split_marker = CmmProc mapEmpty mkSplitMarkerLabel [] $ - ofBlockList (panic "split_marker_entry") [] - cmms' | splitObjs = split_marker : cmms - | otherwise = cmms + -- Generate native code (ngs',us') <- cmmNativeGens dflags this_mod modLoc ncgImpl h - dbgMap us cmms' ngs 0 + dbgMap us cmms ngs 0 -- Link native code information into debug blocks -- See Note [What is this unwinding business?] in Debug. @@ -421,23 +416,10 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs dumpIfSet_dyn dflags Opt_D_dump_debug "Debug Infos" (vcat $ map ppr ldbgs) - -- Emit & clear DWARF information when generating split - -- object files, as we need it to land in the same object file - -- When using split sections, note that we do not split the debug - -- info but emit all the info at once in finishNativeGen. - (ngs'', us'') <- - if debugFlag && splitObjs - then do (dwarf, us'') <- dwarfGen dflags modLoc us ldbgs - emitNativeCode dflags h dwarf - return (ngs' { ngs_debug = [] - , ngs_dwarfFiles = emptyUFM - , ngs_labels = [] }, - us'') - else return (ngs' { ngs_debug = ngs_debug ngs' ++ ldbgs - , ngs_labels = [] }, - us') - - cmmNativeGenStream dflags this_mod modLoc ncgImpl h us'' + -- Accumulate debug information for emission in finishNativeGen. + let ngs'' = ngs' { ngs_debug = ngs_debug ngs' ++ ldbgs, ngs_labels = [] } + + cmmNativeGenStream dflags this_mod modLoc ncgImpl h us' cmm_stream' ngs'' -- | Do native code generation on all these cmms. diff --git a/compiler/nativeGen/CFG.hs b/compiler/nativeGen/CFG.hs index 155e5bcac4..af0c6da455 100644 --- a/compiler/nativeGen/CFG.hs +++ b/compiler/nativeGen/CFG.hs @@ -483,12 +483,7 @@ addNodesBetween m updates = -- | Generate weights for a Cmm proc based on some simple heuristics. getCfgProc :: D.CfgWeights -> RawCmmDecl -> CFG getCfgProc _ (CmmData {}) = mapEmpty --- Sometimes GHC generates dummy procs which don't actually contain code. --- But they might contain bottoms in some fields so we check for an empty --- body first. In particular this happens with SplitObjs enabled. -getCfgProc weights (CmmProc _info _lab _live graph) - | null (toBlockList graph) = mapEmpty - | otherwise = getCfg weights graph +getCfgProc weights (CmmProc _info _lab _live graph) = getCfg weights graph getCfg :: D.CfgWeights -> CmmGraph -> CFG getCfg weights graph = diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs index 280a87e786..b4bf8998d1 100644 --- a/compiler/nativeGen/PIC.hs +++ b/compiler/nativeGen/PIC.hs @@ -563,8 +563,6 @@ pprGotDeclaration _ _ _ -- For each processor architecture, there are two versions, one for PIC -- and one for non-PIC. -- --- Whenever you change something in this assembler output, make sure --- the splitter in driver/split/ghc-split.pl recognizes the new output pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index c54d4430eb..c9d5c2df18 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -49,17 +49,14 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = case topInfoTable proc of Nothing -> sdocWithPlatform $ \platform -> - case blocks of - [] -> -- special case for split markers: - pprLabel lbl - blocks -> -- special case for code without info table: - pprSectionAlign (Section Text lbl) $$ - (case platformArch platform of - ArchPPC_64 ELF_V1 -> pprFunctionDescriptor lbl - ArchPPC_64 ELF_V2 -> pprFunctionPrologue lbl - _ -> pprLabel lbl) $$ -- blocks guaranteed not null, + -- special case for code without info table: + pprSectionAlign (Section Text lbl) $$ + (case platformArch platform of + ArchPPC_64 ELF_V1 -> pprFunctionDescriptor lbl + ArchPPC_64 ELF_V2 -> pprFunctionPrologue lbl + _ -> pprLabel lbl) $$ -- blocks guaranteed not null, -- so label needed - vcat (map (pprBasicBlock top_info) blocks) + vcat (map (pprBasicBlock top_info) blocks) Just (Statics info_lbl _) -> sdocWithPlatform $ \platform -> diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index 065231faf3..3ad01c6d7c 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -504,10 +504,6 @@ stripLive dflags live in CmmProc info label live (ListGraph $ map (stripLiveBlock dflags) $ first' : rest') - -- procs used for stg_split_markers don't contain any blocks, and have no first_id. - stripCmm (CmmProc (LiveInfo info [] _ _) label live []) - = CmmProc info label live (ListGraph []) - -- If the proc has blocks but we don't know what the first one was, then we're dead. stripCmm proc = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc) diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index 42ba13def4..d367b0726a 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -60,13 +60,10 @@ pprNatCmmDecl (CmmData section dats) = pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = case topInfoTable proc of Nothing -> - case blocks of - [] -> -- special case for split markers: - pprLabel lbl - blocks -> -- special case for code without info table: - pprSectionAlign (Section Text lbl) $$ - pprLabel lbl $$ -- blocks guaranteed not null, so label needed - vcat (map (pprBasicBlock top_info) blocks) + -- special case for code without info table: + pprSectionAlign (Section Text lbl) $$ + pprLabel lbl $$ -- blocks guaranteed not null, so label needed + vcat (map (pprBasicBlock top_info) blocks) Just (Statics info_lbl _) -> sdocWithPlatform $ \platform -> diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 83356758af..2d099f9854 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -83,17 +83,14 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprProcAlignment $$ case topInfoTable proc of Nothing -> - case blocks of - [] -> -- special case for split markers: - pprLabel lbl - blocks -> -- special case for code without info table: - pprSectionAlign (Section Text lbl) $$ - pprProcAlignment $$ - pprLabel lbl $$ -- blocks guaranteed not null, so label needed - vcat (map (pprBasicBlock top_info) blocks) $$ - (if debugLevel dflags > 0 - then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ - pprSizeDecl lbl + -- special case for code without info table: + pprSectionAlign (Section Text lbl) $$ + pprProcAlignment $$ + pprLabel lbl $$ -- blocks guaranteed not null, so label needed + vcat (map (pprBasicBlock top_info) blocks) $$ + (if debugLevel dflags > 0 + then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + pprSizeDecl lbl Just (Statics info_lbl _) -> sdocWithPlatform $ \platform -> diff --git a/configure.ac b/configure.ac index 1aae46526e..a803a1faed 100644 --- a/configure.ac +++ b/configure.ac @@ -386,20 +386,6 @@ then fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) - - # NB. Download the perl binaries if required - if ! test -d inplace/perl || - test inplace/perl -ot ghc-tarballs/perl/ghc-perl*.tar.gz - then - AC_MSG_NOTICE([Making in-tree perl tree]) - rm -rf inplace/perl - mkdir inplace/perl - ( - cd inplace/perl && - tar -zxf ../../ghc-tarballs/perl/ghc-perl*.tar.gz - ) - AC_MSG_NOTICE([In-tree perl tree created]) - fi fi # We don't want to bundle a MinGW-w64 toolchain @@ -696,36 +682,6 @@ AC_SUBST([GhcLibsWithUnix]) dnl ** does #! work? AC_SYS_INTERPRETER() -# Check for split-objs -SplitObjsBroken=NO -dnl ** look for `perl' -case $HostOS_CPP in -cygwin32|mingw32) - if test "$EnableDistroToolchain" = "NO"; then - PerlCmd=$hardtop/inplace/perl/perl - else - AC_PATH_PROG([PerlCmd],[perl]) - fi - # because of Trac #15051 SplitObjs is useless on Windows. It regresses - # build times to days for a build, and this effect is also there for end users - # of GHC. So unfortunately we have to disable it, even without having - # split-sections. Though the compile time hit for split-sections should be - # tiny compared to this so maybe we should enable it for x86_64. - SplitObjsBroken=YES - ;; -*) - AC_PATH_PROG([PerlCmd],[perl]) - if test -z "$PerlCmd" - then - AC_MSG_WARN([No Perl on PATH, disabling split object support]) - SplitObjsBroken=YES - else - FPTOOLS_CHECK_PERL_VERSION - fi - ;; -esac -AC_SUBST([SplitObjsBroken]) - dnl ** look for GCC and find out which version dnl Figure out which C compiler to use. Gcc is preferred. dnl If gcc, make sure it's at least 3.0 @@ -1391,7 +1347,6 @@ echo "\ genlib : $GenlibCmd Happy : $HappyCmd ($HappyVersion) Alex : $AlexCmd ($AlexVersion) - Perl : $PerlCmd sphinx-build : $SPHINXBUILD xelatex : $XELATEX diff --git a/distrib/cross-port b/distrib/cross-port index 7c54604ae6..4a1854135a 100644 --- a/distrib/cross-port +++ b/distrib/cross-port @@ -35,7 +35,6 @@ if [ ! -f b1-stamp ]; then echo "GhcUnregisterised = YES" >> mk/build.mk echo "GhcLibHcOpts = -O -H32m -fvia-C -keep-hc-files" >> mk/build.mk echo "GhcLibWays =" >> mk/build.mk - echo "SplitObjs = NO" >> mk/build.mk # We could optimise slightly by not building hslibs here. Also, building # the RTS is not necessary (and might not be desirable if we're using diff --git a/distrib/hc-build b/distrib/hc-build index 43133f83de..13afaa7adb 100644 --- a/distrib/hc-build +++ b/distrib/hc-build @@ -32,7 +32,6 @@ cat >>mk/build.mk <<END GhcUnregisterised=YES GhcWithInterpreter=NO GhcWithNativeCodeGen=NO -SplitObjs=NO GhcLibWays= GhcWithSMP=NO END diff --git a/docs/storage-mgt/rp.tex b/docs/storage-mgt/rp.tex index 2f83532893..199b284b19 100644 --- a/docs/storage-mgt/rp.tex +++ b/docs/storage-mgt/rp.tex @@ -173,7 +173,6 @@ Installing the GHC is done as follows: \begin{code} ./fptools/mk vi build.mk GhcHcOpts = -O -fasm -Rghc-timing - SplitObjs = NO GhcRtsHcOpts = GhcRtsCcOpts = -g STRIP_CMD =: diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index c5bc89a586..8ca0433ba4 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -92,6 +92,11 @@ Compiler taking advantage of :extension:`DerivingStrategies`. The warning is supplied at each ``deriving`` site. +- Support for object splitting with the flag ``-split-objs`` is removed. Using + this flag now results in a warning and does nothing. Use + :ghc-flag:`-split-sections` instead. + + Runtime system ~~~~~~~~~~~~~~ diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index 632162f6c8..9383b8ad68 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -1023,9 +1023,9 @@ extra indirection). ``HSfoo.o`` file that has been pre-linked. Loading the ``.o`` file is slightly quicker, but at the expense of having another copy of the compiled package. The rule of thumb is that if the modules of the - package were compiled with :ghc-flag:`-split-objs` then building the + package were compiled with :ghc-flag:`-split-sections` then building the ``HSfoo.o`` is worthwhile because it saves time when loading the - package into GHCi. Without :ghc-flag:`-split-objs`, there is not much + package into GHCi. Without :ghc-flag:`-split-sections`, there is not much difference in load time between the ``.o`` and ``.a`` libraries, so it is better to save the disk space and only keep the ``.a`` around. In a GHC distribution we provide ``.o`` files for most packages diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index f5f735b81b..0f70368047 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -732,21 +732,6 @@ for example). option for Apple's Linker (``-F`` already means something else for GHC). -.. ghc-flag:: -split-objs - :shortdesc: Split objects (for libraries) - :type: dynamic - :category: linking - - Tell the linker to split the single object file that would normally - be generated into multiple object files, one per top-level Haskell - function or type in the module. This only makes sense for libraries, - where it means that executables linked against the library are - smaller as they only link against the object files that they need. - However, assembling all the sections separately is expensive, so - this is slower than compiling normally. Additionally, the size of - the library itself (the ``.a`` file) can be a factor of 2 to 2.5 - larger. - .. ghc-flag:: -split-sections :shortdesc: Split sections for link-time dead-code stripping :type: dynamic @@ -758,9 +743,7 @@ for example). output file. When linking, the linker can automatically remove all unreferenced sections - and thus produce smaller executables. The effect is similar to - :ghc-flag:`-split-objs`, but somewhat more efficient - the generated library - files are about 30% smaller than with :ghc-flag:`-split-objs`. + and thus produce smaller executables. .. ghc-flag:: -static :shortdesc: Use static Haskell libraries diff --git a/driver/split/Makefile b/driver/split/Makefile deleted file mode 100644 index 93e9b127eb..0000000000 --- a/driver/split/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - -dir = driver/split -TOP = ../.. -include $(TOP)/mk/sub-makefile.mk diff --git a/driver/split/ghc-split.pl b/driver/split/ghc-split.pl deleted file mode 100644 index 1b3a3ed47c..0000000000 --- a/driver/split/ghc-split.pl +++ /dev/null @@ -1,275 +0,0 @@ -#************************************************************************ -#* * -#* \section[Driver-obj-splitting]{Splitting into many \tr{.o} files (for libraries)} -#* * -#************************************************************************ - -$TargetPlatform = $TARGETPLATFORM; - -($Pgm = $0) =~ s|.*/||; -$ifile = $ARGV[0]; -$Tmp_prefix = $ARGV[1]; -$Output = $ARGV[2]; - -&split_asm_file($ifile); - -open(OUTPUT, '>', $Output) || &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n"); -print OUTPUT "$NoOfSplitFiles\n"; -close(OUTPUT); - -exit(0); - - -sub split_asm_file { - (my $asm_file,) = @_; - my @pieces = (); - - open(TMPI, '<', $asm_file) || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n"); - - - $octr = 0; # output file counter - - %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants... - - $s_stuff = &ReadTMPIUpToAMarker( '', $octr ); - # that first stuff is a prologue for all .s outputs - $prologue_stuff = &process_asm_block ( $s_stuff ); - # $_ already has some of the next stuff in it... - -# &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n") -# if $prologue_stuff eq $s_stuff; - - while ( $_ ne '' ) { # not EOF - $octr++; - - # grab and de-mangle a section of the .s file... - $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr ); - $pieces[$octr] = &process_asm_block ( $s_stuff ); - } - - # Make sure that we still have some output when the input file is empty - if ($octr == 0) { - $octr = 1; - $pieces[$octr] = ''; - } - - $NoOfSplitFiles = $octr; - - if ($pieces[$NoOfSplitFiles] =~ /(\n[ \t]*\.section[ \t]+\.note\.GNU-stack,[^\n]*\n)/m) { - $note_gnu_stack = $1; - for $octr (1..($NoOfSplitFiles - 1)) { - $pieces[$octr] .= $note_gnu_stack; - } - } - - for $octr (1..$NoOfSplitFiles) { - # output to a file of its own - # open a new output file... - $ofname = "${Tmp_prefix}__${octr}.s"; - open(OUTF, '>', $ofname) || die "$Pgm: can't open output file: $ofname\n"; - - print OUTF $prologue_stuff; - print OUTF $pieces[$octr]; - - close(OUTF) - || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n"); - } - - close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n"); -} - -sub ReadTMPIUpToAMarker { - (my $str, my $count) = @_; # already read bits - - - for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/m; $_ = <TMPI> ) { - $str .= $_; - } - # if not EOF, then creep forward until next "real" line - # (throwing everything away). - # that first "real" line will stay in $_. - - # This loop is intended to pick up the body of the split_marker function - - while ($_ ne '' && (/_?__stg_split_marker/m - || /^L[^C].*:$/m - || /\t\.frame/m - # || /\t\.end/ NOT! Let the split_marker regexp catch it - # || /\t\.ent/ NOT! Let the split_marker regexp catch it - || /^\s+(save|retl?|restore|nop)/m)) { - $_ = <TMPI>; - } - - print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info; - - # return str - $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/m; # in case Perl doesn't convert line endings - $str; -} -=pod - -We must (a)~strip the marker off the block, (b)~record any literal C -constants that are defined here, and (c)~inject copies of any C constants -that are used-but-not-defined here. - -=cut - -sub process_asm_block { - local($str) = @_; - - return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/m; - return(&process_asm_block_iX86($str)) if $TargetPlatform =~ /^i[34]86-/m; - return(&process_asm_block_x86_64($str)) if $TargetPlatform =~ /^x86_64-/m; - return(&process_asm_block_powerpc_linux($str)) - if $TargetPlatform =~ /^powerpc-[^-]+-linux/m; - - # otherwise... - &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n"); -} - -sub process_asm_block_sparc { - local($str) = @_; - - # strip the marker - $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/m; - $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/m; - - # remove/record any literal constants defined here - while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/m ) { - local($label) = $2; - local($body) = $1; - - &tidy_up_and_die(1,"Local constant label $label already defined!\n") - if $LocalConstant{$label}; - - $LocalConstant{$label} = $body; - - $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//m; - } - - # inject definitions for any local constants now used herein - foreach $k (keys %LocalConstant) { - if ( $str =~ /\b$k\b/m ) { - $str = $LocalConstant{$k} . $str; - } - } - - print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info; - - $str; -} - -sub process_asm_block_iX86 { - (my $str,) = @_; - - # strip the marker - - $str =~ s/(\.text\n\t\.align .(?:,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/m; - $str =~ s/(\t\.align .(?:,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/m; - - # it seems prudent to stick on one of these: - $str = "\.text\n\t.align 4\n" . $str; - - # remove/record any literal constants defined here - # [perl made uglier to work around the perl 5.7/5.8 bug documented at - # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated - # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/' - # -- ccshan 2002-09-05] - while ( ($str =~ /((?:^|\.)(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/m )) { - local($label) = $2; - local($body) = $1; - local($prefix, $suffix) = ($`, $'); - - &tidy_up_and_die(1,"Local constant label $label already defined!\n") - if $LocalConstant{$label}; - - while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) { - $body .= $1; - $suffix = $'; - } - $LocalConstant{$label} = $body; - $str = $prefix . $suffix; - } - - # inject definitions for any local constants now used herein - foreach $k (keys %LocalConstant) { - if ( $str =~ /\b$k\b/m ) { - $str = $LocalConstant{$k} . $str; - } - } - - print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info; - - $str; -} - -sub process_asm_block_x86_64 { - local($str) = @_; - - # remove/record any literal constants defined here - # [perl made uglier to work around the perl 5.7/5.8 bug documented at - # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated - # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/' - # -- ccshan 2002-09-05] - while ( ($str =~ /((?:^|\.)(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/m )) { - local($label) = $2; - local($body) = $1; - local($prefix, $suffix) = ($`, $'); - - &tidy_up_and_die(1,"Local constant label $label already defined!\n") - if $LocalConstant{$label}; - - while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) { - $body .= $1; - $suffix = $'; - } - $LocalConstant{$label} = $body; - $str = $prefix . $suffix; - } - - # inject definitions for any local constants now used herein - foreach $k (keys %LocalConstant) { - if ( $str =~ /\b$k\b/m ) { - $str = $LocalConstant{$k} . $str; - } - } - - print STDERR "### STRIPPED BLOCK (x86_64):\n$str" if $Dump_asm_splitting_info; - - $str; -} - -sub process_asm_block_powerpc_linux { - local($str) = @_; - - # strip the marker - $str =~ s/__stg_split_marker.*\n//m; - - # remove/record any literal constants defined here - while ( $str =~ s/^(\s+.section\s+\.rodata\n\s+\.align.*\n(\.LC\d+):\n(\s\.(byte|short|long|quad|2byte|4byte|8byte|fill|space|ascii|string).*\n)+)//m ) { - local($label) = $2; - local($body) = $1; - - &tidy_up_and_die(1,"Local constant label $label already defined!\n") - if $LocalConstant{$label}; - - $LocalConstant{$label} = $body; - } - - # inject definitions for any local constants now used herein - foreach $k (keys %LocalConstant) { - if ( $str =~ /[\s,]$k\b/m ) { - $str = $LocalConstant{$k} . $str; - } - } - - print STDERR "### STRIPPED BLOCK (powerpc linux):\n$str" if $Dump_asm_splitting_info; - - $str; -} - -sub tidy_up_and_die { - local($return_val, $msg) = @_; - print STDERR $msg; - exit (($return_val == 0) ? 0 : 1); -} diff --git a/driver/split/ghc.mk b/driver/split/ghc.mk deleted file mode 100644 index 9d34a59a24..0000000000 --- a/driver/split/ghc.mk +++ /dev/null @@ -1,20 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - -driver/split_PERL_SRC = ghc-split.pl -driver/split_dist_PROGNAME = ghc-split -driver/split_dist_TOPDIR = YES -driver/split_dist_INSTALL = YES -driver/split_dist_INSTALL_INPLACE = YES - -$(eval $(call build-perl,driver/split,dist)) - @@ -330,11 +330,6 @@ include rules/build-prog.mk include rules/shell-wrapper.mk # ----------------------------------------------------------------------------- -# Build a perl script - -include rules/build-perl.mk - -# ----------------------------------------------------------------------------- # Build a package include rules/build-package.mk @@ -626,7 +621,6 @@ BUILD_DIRS += utils/mkdirhier BUILD_DIRS += utils/touchy BUILD_DIRS += utils/unlit BUILD_DIRS += utils/hp2ps -BUILD_DIRS += driver/split BUILD_DIRS += utils/genprimopcode BUILD_DIRS += driver BUILD_DIRS += driver/ghci @@ -700,9 +694,6 @@ endif ifeq "$(Windows_Host)" "NO" BUILD_DIRS := $(filter-out utils/touchy,$(BUILD_DIRS)) endif -ifeq "$(GhcUnregisterised)" "YES" -BUILD_DIRS := $(filter-out driver/split,$(BUILD_DIRS)) -endif ifeq "$(GhcWithInterpreter)" "NO" # runghc is just GHCi in disguise BUILD_DIRS := $(filter-out utils/runghc,$(BUILD_DIRS)) @@ -1422,7 +1413,6 @@ distclean : clean # Also clean Windows-only inplace directories. # Don't delete 'inplace' itself, it contains source files. $(call removeTrees,inplace/mingw) - $(call removeTrees,inplace/perl) # Remove the fs utilities. $(call removeFiles,utils/lndir/fs.h) diff --git a/ghc/ghc.mk b/ghc/ghc.mk index 6e329352ef..f9a3d1f056 100644 --- a/ghc/ghc.mk +++ b/ghc/ghc.mk @@ -154,12 +154,6 @@ $(GHC_STAGE1) : | $(GHC_DEPENDENCIES) $(GHC_STAGE2) : | $(GHC_DEPENDENCIES) $(GHC_STAGE3) : | $(GHC_DEPENDENCIES) -ifeq "$(GhcUnregisterised)" "NO" -$(GHC_STAGE1) : | $$(ghc-split_INPLACE) -$(GHC_STAGE2) : | $$(ghc-split_INPLACE) -$(GHC_STAGE3) : | $$(ghc-split_INPLACE) -endif - ifeq "$(Windows_Host)" "YES" $(GHC_STAGE1) : | $$(touchy_INPLACE) $(GHC_STAGE2) : | $$(touchy_INPLACE) diff --git a/hadrian/README.md b/hadrian/README.md index 7b6646d655..179d9d07ce 100644 --- a/hadrian/README.md +++ b/hadrian/README.md @@ -114,10 +114,6 @@ four settings: `none`, `brief` (one line per build command; this is the default setting), `normal` (typically a box per build command), and `unicorn` (when `normal` just won't do). -* `--split-objects`: generate split objects, which are switched off by default. -Due to a GHC [bug][ghc-split-objs-bug], you need a full clean rebuild when using -this flag. - * `--verbose`: run Hadrian in verbose mode. In particular this prints diagnostic messages by Shake oracles. @@ -263,7 +259,6 @@ projects), as well as Well-Typed. [ghc-preparation]: https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation [ghc-windows-quick-build]: https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Windows#AQuickBuild [windows-build]: https://gitlab.haskell.org/ghc/ghc/blob/master/hadrian/doc/windows.md -[ghc-split-objs-bug]: https://ghc.haskell.org/trac/ghc/ticket/11315 [test-issue]: https://github.com/snowleopard/hadrian/issues/197 [validation-issue]: https://github.com/snowleopard/hadrian/issues/187 [dynamic-windows-issue]: https://github.com/snowleopard/hadrian/issues/343 diff --git a/hadrian/cfg/system.config.in b/hadrian/cfg/system.config.in index 4cae2b6783..affeeaa5d5 100644 --- a/hadrian/cfg/system.config.in +++ b/hadrian/cfg/system.config.in @@ -43,7 +43,6 @@ hs-cpp-args = @HaskellCPPArgs@ #=============== solaris-broken-shld = @SOLARIS_BROKEN_SHLD@ -split-objects-broken = @SplitObjsBroken@ ghc-unregisterised = @Unregisterised@ ghc-source-path = @hardtop@ leading-underscore = @LeadingUnderscore@ diff --git a/hadrian/doc/user-settings.md b/hadrian/doc/user-settings.md index 68929d325a..d0531a3f3d 100644 --- a/hadrian/doc/user-settings.md +++ b/hadrian/doc/user-settings.md @@ -23,8 +23,6 @@ data Flavour = Flavour { libraryWays :: Ways, -- | Build RTS these ways. rtsWays :: Ways, - -- | Build split objects. - splitObjects :: Predicate, -- | Build dynamic GHC programs. dynamicGhcPrograms :: Action Bool, -- | Enable GHCi debugger. @@ -275,13 +273,6 @@ their effects. ## Miscellaneous -To change the default behaviour of Hadrian with respect to building split -objects, override the `splitObjects` setting of the `Flavour` record: -```haskell -userFlavour :: Flavour -userFlavour = defaultFlavour { name = "user", splitObjects = return False } -``` - Hadrian prints various progress info during the build. You can change the colours used by default by overriding `buildProgressColour` and `successColour`: ```haskell diff --git a/hadrian/src/Base.hs b/hadrian/src/Base.hs index 47d9107669..19573de8fd 100644 --- a/hadrian/src/Base.hs +++ b/hadrian/src/Base.hs @@ -26,7 +26,6 @@ module Base ( generatedDir, generatedPath, stageBinPath, stageLibPath, templateHscPath, ghcDeps, includesDependencies, haddockDeps, relativePackageDbPath, packageDbPath, packageDbStamp, mingwStamp, - ghcSplitPath ) where import Control.Applicative @@ -138,12 +137,6 @@ haddockDeps stage = do templateHscPath :: Stage -> Action FilePath templateHscPath stage = stageLibPath stage <&> (-/- "template-hsc.h") --- | @ghc-split@ is a Perl script used by GHC when run with @-split-objs@ flag. --- It is generated in "Rules.Generate". This function returns the path relative --- to the build root under which we will copy @ghc-split@. -ghcSplitPath :: Stage -> FilePath -ghcSplitPath stage = stageString stage -/- "bin" -/- "ghc-split" - -- | We use this stamp file to track whether we've moved the mingw toolchain -- under the build root (to make it accessible to the GHCs we build on -- Windows). See "Rules.Program". diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs index b56f9c1071..6c14eb4517 100644 --- a/hadrian/src/Builder.hs +++ b/hadrian/src/Builder.hs @@ -181,8 +181,7 @@ instance H.Builder Builder where unlitPath <- builderPath Unlit ghcdeps <- ghcDeps stage ghcgens <- generatedGhcDependencies stage - return $ [ root -/- ghcSplitPath stage -- TODO: Make conditional on --split-objects - , unlitPath ] + return $ [ unlitPath ] ++ ghcdeps ++ ghcgens ++ [ touchyPath | win ] diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs index 842fb037cc..75e981222a 100644 --- a/hadrian/src/CommandLine.hs +++ b/hadrian/src/CommandLine.hs @@ -1,6 +1,6 @@ module CommandLine ( optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple, - cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects, + cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdDocsArgs, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs ) where @@ -25,7 +25,6 @@ data CommandLineArgs = CommandLineArgs , integerSimple :: Bool , progressColour :: UseColour , progressInfo :: ProgressInfo - , splitObjects :: Bool , buildRoot :: BuildRoot , testArgs :: TestArgs , docTargets :: DocTargets } @@ -40,7 +39,6 @@ defaultCommandLineArgs = CommandLineArgs , integerSimple = False , progressColour = Auto , progressInfo = Brief - , splitObjects = False , buildRoot = BuildRoot "_build" , testArgs = defaultTestArgs , docTargets = Set.fromList [minBound..maxBound] } @@ -121,9 +119,6 @@ readProgressInfo ms = set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs set flag flags = flags { progressInfo = flag } -readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs) -readSplitObjects = Right $ \flags -> flags { splitObjects = True } - readTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestCompiler compiler = maybe (Left "Cannot parse compiler") (Right . set) compiler where @@ -220,8 +215,6 @@ optDescrs = "Use colours in progress info (Never, Auto or Always)." , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE") "Progress info style (None, Brief, Normal or Unicorn)." - , Option [] ["split-objects"] (NoArg readSplitObjects) - "Generate split objects (requires a full clean rebuild)." , Option [] ["docs"] (OptArg readDocsArg "TARGET") "Strip down docs targets (none, no-haddocks, no-sphinx[-{html, pdfs, man}]." , Option [] ["test-compiler"] (OptArg readTestCompiler "TEST_COMPILER") @@ -283,8 +276,5 @@ cmdProgressColour = progressColour <$> cmdLineArgs cmdProgressInfo :: Action ProgressInfo cmdProgressInfo = progressInfo <$> cmdLineArgs -cmdSplitObjects :: Action Bool -cmdSplitObjects = splitObjects <$> cmdLineArgs - cmdDocsArgs :: Action DocTargets cmdDocsArgs = docTargets <$> cmdLineArgs diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs index 4a71e80c45..06407e7022 100644 --- a/hadrian/src/Flavour.hs +++ b/hadrian/src/Flavour.hs @@ -26,8 +26,6 @@ data Flavour = Flavour { libraryWays :: Ways, -- | Build RTS these ways. rtsWays :: Ways, - -- | Build split objects. - splitObjects :: Predicate, -- | Build dynamic GHC programs. dynamicGhcPrograms :: Action Bool, -- | Enable GHCi debugger. diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs index b294cebc93..4f5116bf41 100644 --- a/hadrian/src/Oracles/Flag.hs +++ b/hadrian/src/Oracles/Flag.hs @@ -1,6 +1,6 @@ module Oracles.Flag ( Flag (..), flag, getFlag, platformSupportsSharedLibs, ghcWithSMP, - ghcWithNativeCodeGen, supportsSplitObjects + ghcWithNativeCodeGen ) where import Hadrian.Oracles.TextFile @@ -17,7 +17,6 @@ data Flag = ArSupportsAtFile | GmpFrameworkPref | LeadingUnderscore | SolarisBrokenShld - | SplitObjectsBroken | WithLibdw | HaveLibMingwEx | UseSystemFfi @@ -35,7 +34,6 @@ flag f = do GmpFrameworkPref -> "gmp-framework-preferred" LeadingUnderscore -> "leading-underscore" SolarisBrokenShld -> "solaris-broken-shld" - SplitObjectsBroken -> "split-objects-broken" WithLibdw -> "with-libdw" HaveLibMingwEx -> "have-lib-mingw-ex" UseSystemFfi -> "use-system-ffi" @@ -69,12 +67,3 @@ ghcWithNativeCodeGen = do badOs <- anyTargetOs ["ios", "aix"] ghcUnreg <- flag GhcUnregisterised return $ goodArch && not badOs && not ghcUnreg - -supportsSplitObjects :: Action Bool -supportsSplitObjects = do - broken <- flag SplitObjectsBroken - ghcUnreg <- flag GhcUnregisterised - goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc" ] - goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "darwin", "solaris2" - , "freebsd", "dragonfly", "netbsd", "openbsd" ] - return $ not broken && not ghcUnreg && goodArch && goodOs diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs index 75a74b2ae6..2738c6952d 100644 --- a/hadrian/src/Packages.hs +++ b/hadrian/src/Packages.hs @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr, compareSizes, compiler, containers, deepseq, deriveConstants, directory, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact, - ghcHeap, ghci, ghcPkg, ghcPrim, ghcSplit, haddock, haskeline, + ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl, parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, @@ -69,7 +69,6 @@ ghcHeap = lib "ghc-heap" ghci = lib "ghci" ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" -ghcSplit = util "ghc-split" haddock = util "haddock" haskeline = lib "haskeline" hsc2hs = util "hsc2hs" diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs index d54ac3d140..609766d5ca 100644 --- a/hadrian/src/Rules/BinaryDist.hs +++ b/hadrian/src/Rules/BinaryDist.hs @@ -134,7 +134,7 @@ bindistRules = do need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) need $ map ((bindistFilesDir -/- "wrappers") -/-) ["check-api-annotations" - , "check-ppr", "ghc", "ghc-iserv", "ghc-pkg", "ghc-split" + , "check-ppr", "ghc", "ghc-iserv", "ghc-pkg" , "ghci-script", "ghci", "haddock", "hpc", "hp2ps", "hsc2hs" , "runghc"] diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs index 13544f2a7d..032f6a68c1 100644 --- a/hadrian/src/Rules/Generate.hs +++ b/hadrian/src/Rules/Generate.hs @@ -174,11 +174,6 @@ generateRules = do priority 2.0 $ (root -/- generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH priority 2.0 $ (root -/- generatedDir -/- "ghcversion.h") <~ generateGhcVersionH - forM_ [Stage0 ..] $ \stage -> - root -/- ghcSplitPath stage %> \path -> do - generate path emptyTarget generateGhcSplit - makeExecutable path - -- TODO: simplify, get rid of fake rts context root -/- generatedDir ++ "//*" %> \file -> do withTempDir $ \dir -> build $ @@ -200,26 +195,6 @@ emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage") cppify :: String -> String cppify = replaceEq '-' '_' . replaceEq '.' '_' -ghcSplitSource :: FilePath -ghcSplitSource = "driver/split/ghc-split.pl" - --- ref: rules/build-perl.mk --- | Generate the @ghc-split@ Perl script. -generateGhcSplit :: Expr String -generateGhcSplit = do - trackGenerateHs - targetPlatform <- getSetting TargetPlatform - ghcEnableTNC <- expr $ yesNo <$> ghcEnableTablesNextToCode - perlPath <- getBuilderPath Perl - contents <- expr $ readFileLines ghcSplitSource - return . unlines $ - [ "#!" ++ perlPath - , "my $TARGETPLATFORM = " ++ show targetPlatform ++ ";" - -- I don't see where the ghc-split tool uses TNC, but - -- it's in the build-perl macro. - , "my $TABLES_NEXT_TO_CODE = " ++ show ghcEnableTNC ++ ";" - ] ++ contents - -- | Generate @ghcplatform.h@ header. generateGhcPlatformH :: Expr String generateGhcPlatformH = do @@ -289,7 +264,6 @@ generateConfigHs = do | intLib == integerGmp = "IntegerGMP" | intLib == integerSimple = "IntegerSimple" | otherwise = error $ "Unknown integer library: " ++ pkgName intLib - cSupportsSplitObjs <- expr $ yesNo <$> supportsSplitObjects cGhcWithInterpreter <- expr $ yesNo <$> ghcWithInterpreter cGhcWithNativeCodeGen <- expr $ yesNo <$> ghcWithNativeCodeGen cGhcWithSMP <- expr $ yesNo <$> ghcWithSMP @@ -341,8 +315,6 @@ generateConfigHs = do , "cIntegerLibrary = " ++ show (pkgName intLib) , "cIntegerLibraryType :: IntegerLibrary" , "cIntegerLibraryType = " ++ cIntegerLibraryType - , "cSupportsSplitObjs :: String" - , "cSupportsSplitObjs = " ++ show cSupportsSplitObjs , "cGhcWithInterpreter :: String" , "cGhcWithInterpreter = " ++ show cGhcWithInterpreter , "cGhcWithNativeCodeGen :: String" @@ -357,8 +329,6 @@ generateConfigHs = do , "cLeadingUnderscore = " ++ show cLeadingUnderscore , "cGHC_UNLIT_PGM :: String" , "cGHC_UNLIT_PGM = " ++ show cGHC_UNLIT_PGM - , "cGHC_SPLIT_PGM :: String" - , "cGHC_SPLIT_PGM = " ++ show "ghc-split" , "cLibFFI :: Bool" , "cLibFFI = " ++ show cLibFFI , "cGhcThreaded :: Bool" diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs index d19907bfa9..edec160cc2 100644 --- a/hadrian/src/Rules/Library.hs +++ b/hadrian/src/Rules/Library.hs @@ -121,18 +121,8 @@ libraryObjects :: Context -> Action [FilePath] libraryObjects context@Context{..} = do hsObjs <- hsObjects context noHsObjs <- nonHsObjects context - - -- This will create split objects if required (we don't track them - -- explicitly as this would needlessly bloat the Shake database). need $ noHsObjs ++ hsObjs - - split <- interpretInContext context =<< splitObjects <$> flavour - let getSplitObjs = concatForM hsObjs $ \obj -> do - let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split" - contents <- liftIO $ IO.getDirectoryContents dir - return . map (dir -/-) $ filter (not . all (== '.')) contents - - (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs + return (noHsObjs ++ hsObjs) -- * Library paths types and parsers diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs index 4bc10e5edd..b952a017bc 100644 --- a/hadrian/src/Settings/Builders/Ghc.hs +++ b/hadrian/src/Settings/Builders/Ghc.hs @@ -17,7 +17,6 @@ compileAndLinkHs :: Args compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do mconcat [ arg "-Wall" , commonGhcArgs - , splitObjects <$> flavour ? arg "-split-objs" , ghcLinkArgs , defaultGhcWarningsArgs , builder (Ghc CompileHs) ? arg "-c" diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs index 084dcf3d42..b74ee09499 100644 --- a/hadrian/src/Settings/Default.hs +++ b/hadrian/src/Settings/Default.hs @@ -10,7 +10,7 @@ module Settings.Default ( defaultArgs, -- * Default build flavour - defaultFlavour, defaultSplitObjects + defaultFlavour ) where import qualified Hadrian.Builder.Ar @@ -210,7 +210,6 @@ defaultFlavour = Flavour , integerLibrary = (\x -> if x then integerSimple else integerGmp) <$> cmdIntegerSimple , libraryWays = defaultLibraryWays , rtsWays = defaultRtsWays - , splitObjects = defaultSplitObjects , dynamicGhcPrograms = defaultDynamicGhcPrograms , ghciWithDebugger = False , ghcProfiled = False @@ -228,16 +227,6 @@ defaultDynamicGhcPrograms = do supportsShared <- platformSupportsSharedLibs return (not win && supportsShared) --- | Default condition for building split objects. -defaultSplitObjects :: Predicate -defaultSplitObjects = do - goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages - pkg <- getPackage - supported <- expr supportsSplitObjects - split <- expr cmdSplitObjects - let goodPackage = isLibrary pkg && pkg /= compiler && pkg /= rts - return $ split && goodStage && goodPackage && supported - -- | All 'Builder'-dependent command line arguments. defaultBuilderArgs :: Args defaultBuilderArgs = mconcat diff --git a/hadrian/src/Settings/Default.hs-boot b/hadrian/src/Settings/Default.hs-boot index 30a28497e9..e2996d9c71 100644 --- a/hadrian/src/Settings/Default.hs-boot +++ b/hadrian/src/Settings/Default.hs-boot @@ -1,7 +1,7 @@ module Settings.Default ( SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, defaultArgs, defaultLibraryWays, defaultRtsWays, - defaultFlavour, defaultSplitObjects + defaultFlavour ) where import Flavour @@ -18,4 +18,3 @@ sourceArgs :: SourceArgs -> Args defaultBuilderArgs, defaultPackageArgs, defaultArgs :: Args defaultLibraryWays, defaultRtsWays :: Ways defaultFlavour :: Flavour -defaultSplitObjects :: Predicate diff --git a/mk/config.mk.in b/mk/config.mk.in index 2bff8432e4..55fb808c5a 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -327,39 +327,9 @@ GhcLibHcOpts=-O2 -haddock StripLibraries=NO # ---------------------------------------------------------------------------- -# Object-file splitting -# -# Set SplitObjs=YES or NO in your build.mk -# -# Don't use -split-objs in in GhcLibHcOpts, because the build -# system needs to do other special magic if you are -# doing object-file splitting - -ArchSupportsSplitObjs=$(if $(filter \ - $(TargetArch_CPP),i386 x86_64 powerpc sparc),YES,NO)# - -# We used to support splitting on Darwin, but there is no point, since Darwin -# uses subsections via symbols -OsSupportsSplitObjs=$(if $(filter $(TargetOS_CPP),\ - mingw32 linux solaris2 freebsd dragonfly netbsd openbsd),YES,NO) -SplitObjsBroken = @SplitObjsBroken@ - -SupportsSplitObjs := $(if $(and $(filter YES,$(ArchSupportsSplitObjs)),\ - $(filter YES,$(OsSupportsSplitObjs)),\ - $(filter NO,$(SplitObjsBroken)),\ - $(filter YES,$(GhcWithNativeCodeGen))),YES,NO) - -# By default, enable SplitObjs for the libraries if this build supports it. -# Unless SplitSections is enabled - then let that take precedence. -SplitObjs = $(if $(and $(filter YES,$(SupportsSplitObjs)),\ - $(filter NO,$(SplitSections))),YES,NO) - -# ---------------------------------------------------------------------------- # Section splitting # -# Similar to -ffunction-sections -fdata-sections in GCC. Provides space saving -# like SplitObjs, but doesn't require post-processing and splitting of object -# files. +# Similar to -ffunction-sections -fdata-sections in GCC. # # Set SplitSections=YES or NO in your build.mk to override the default. # diff --git a/mk/flavours/bench-cross-ncg.mk b/mk/flavours/bench-cross-ncg.mk index 0d42938c24..1fc7b245a0 100644 --- a/mk/flavours/bench-cross-ncg.mk +++ b/mk/flavours/bench-cross-ncg.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O0 GhcLibHcOpts = -O2 BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/bench-cross.mk b/mk/flavours/bench-cross.mk index ae67f34d17..7d1d4c4260 100644 --- a/mk/flavours/bench-cross.mk +++ b/mk/flavours/bench-cross.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O GhcStage2HcOpts = -O0 -fllvm GhcLibHcOpts = -O2 -fllvm BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/bench-llvm.mk b/mk/flavours/bench-llvm.mk index 9b71005615..58fb92df21 100644 --- a/mk/flavours/bench-llvm.mk +++ b/mk/flavours/bench-llvm.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O GhcStage2HcOpts = -O0 GhcLibHcOpts = -O2 BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/bench.mk b/mk/flavours/bench.mk index 73015aaf44..ecfc535178 100644 --- a/mk/flavours/bench.mk +++ b/mk/flavours/bench.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O0 GhcLibHcOpts = -O2 BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/devel1.mk b/mk/flavours/devel1.mk index 8c8925c934..e062a57909 100644 --- a/mk/flavours/devel1.mk +++ b/mk/flavours/devel1.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O0 -DDEBUG GhcStage2HcOpts = -O GhcLibHcOpts = -O -dcore-lint BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/devel2.mk b/mk/flavours/devel2.mk index dc8be47578..1c8e24f745 100644 --- a/mk/flavours/devel2.mk +++ b/mk/flavours/devel2.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O0 -DDEBUG GhcLibHcOpts = -O -dcore-lint BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/perf-cross-ncg.mk b/mk/flavours/perf-cross-ncg.mk index 4b94c48805..56ecc79b13 100644 --- a/mk/flavours/perf-cross-ncg.mk +++ b/mk/flavours/perf-cross-ncg.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O2 GhcLibHcOpts = -O2 BUILD_PROF_LIBS = YES -#SplitObjs HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO BUILD_SPHINX_PDF = NO diff --git a/mk/flavours/perf-cross.mk b/mk/flavours/perf-cross.mk index f202642b7d..9e48ce9605 100644 --- a/mk/flavours/perf-cross.mk +++ b/mk/flavours/perf-cross.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O2 -fllvm GhcLibHcOpts = -O2 -fllvm BUILD_PROF_LIBS = YES -#SplitObjs HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO BUILD_SPHINX_PDF = NO diff --git a/mk/flavours/perf-llvm.mk b/mk/flavours/perf-llvm.mk index cd3d4f4a40..2598f4a40d 100644 --- a/mk/flavours/perf-llvm.mk +++ b/mk/flavours/perf-llvm.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O GhcStage2HcOpts = -O2 GhcLibHcOpts = -O2 BUILD_PROF_LIBS = YES -#SplitObjs #HADDOCK_DOCS #BUILD_SPHINX_HTML #BUILD_SPHINX_PDF diff --git a/mk/flavours/perf.mk b/mk/flavours/perf.mk index ec314bd589..ee856626ad 100644 --- a/mk/flavours/perf.mk +++ b/mk/flavours/perf.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O2 GhcLibHcOpts = -O2 BUILD_PROF_LIBS = YES -#SplitObjs #HADDOCK_DOCS #BUILD_SPHINX_HTML #BUILD_SPHINX_PDF diff --git a/mk/flavours/prof-llvm.mk b/mk/flavours/prof-llvm.mk index dcbd6a4bab..9c284432aa 100644 --- a/mk/flavours/prof-llvm.mk +++ b/mk/flavours/prof-llvm.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O GhcStage2HcOpts = -O GhcLibHcOpts = -O BUILD_PROF_LIBS = YES -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/prof.mk b/mk/flavours/prof.mk index c7e0e2863f..6c4a6baac3 100644 --- a/mk/flavours/prof.mk +++ b/mk/flavours/prof.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O GhcLibHcOpts = -O BUILD_PROF_LIBS = YES -SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO BUILD_SPHINX_PDF = NO diff --git a/mk/flavours/quick-cross-ncg.mk b/mk/flavours/quick-cross-ncg.mk index 5ca88c0208..471b37dc6b 100644 --- a/mk/flavours/quick-cross-ncg.mk +++ b/mk/flavours/quick-cross-ncg.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O0 GhcLibHcOpts = -O BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/quick-cross.mk b/mk/flavours/quick-cross.mk index f0f00d28ac..98defa700c 100644 --- a/mk/flavours/quick-cross.mk +++ b/mk/flavours/quick-cross.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O GhcStage2HcOpts = -O0 -fllvm GhcLibHcOpts = -O -fllvm BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/quick-llvm.mk b/mk/flavours/quick-llvm.mk index 8a5c5e1c26..9869041012 100644 --- a/mk/flavours/quick-llvm.mk +++ b/mk/flavours/quick-llvm.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O GhcStage2HcOpts = -O0 GhcLibHcOpts = -O BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/quick.mk b/mk/flavours/quick.mk index 30322cd691..286cb2ed23 100644 --- a/mk/flavours/quick.mk +++ b/mk/flavours/quick.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O0 GhcLibHcOpts = -O BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/quickest.mk b/mk/flavours/quickest.mk index 5204acb20f..5583748eb9 100644 --- a/mk/flavours/quickest.mk +++ b/mk/flavours/quickest.mk @@ -3,7 +3,6 @@ GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O0 GhcLibHcOpts = -O0 BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO diff --git a/mk/flavours/validate.mk b/mk/flavours/validate.mk index a1470cd610..ba33584488 100644 --- a/mk/flavours/validate.mk +++ b/mk/flavours/validate.mk @@ -4,7 +4,6 @@ GhcStage1HcOpts = -O2 -DDEBUG GhcStage2HcOpts = -O -dcore-lint -dno-debug-output GhcLibHcOpts = -O -dcore-lint -dno-debug-output BUILD_PROF_LIBS = NO -SplitObjs = NO SplitSections = NO HADDOCK_DOCS = YES BUILD_SPHINX_HTML = YES diff --git a/rules/build-package-way.mk b/rules/build-package-way.mk index f9eca23cce..122ec60a90 100644 --- a/rules/build-package-way.mk +++ b/rules/build-package-way.mk @@ -74,12 +74,7 @@ else # ifneq "$3" "dyn" # Build the ordinary .a library $$($1_$2_$3_LIB) : $$($1_$2_$3_ALL_OBJS) $$(call removeFiles,$$@ $$@.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) >> $$@.contents -else echo $$($1_$2_$3_ALL_OBJS) >> $$@.contents -endif ifeq "$$($1_$2_ArSupportsAtFile)" "YES" $$(call cmd,$1_$2_AR) $$($1_$2_AR_OPTS) $$($1_$2_EXTRA_AR_ARGS) $$@ @$$@.contents else diff --git a/rules/build-perl.mk b/rules/build-perl.mk deleted file mode 100644 index 6bec7d93e7..0000000000 --- a/rules/build-perl.mk +++ /dev/null @@ -1,78 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - - -# Build a perl script. Invoke like this: -# -# driver/mangler_PERL_SRC = ghc-asm.pl -# driver/mangler_dist_PROGNAME = ghc-asm -# -# $(eval $(call build-perl,driver/mangler,dist)) - -define build-perl -$(call trace, build-perl($1,$2)) -$(call profStart, build-perl($1,$2)) -# $1 = dir -# $2 = distdir - -ifeq "$$($1_$2_PROGNAME)" "" -$$(error $1_$2_PROGNAME is not set) -endif -ifneq "$$($1_$2_PROG)" "" -$$(error $1_$2_PROG is set) -endif -$1_$2_PROG = $$($1_$2_PROGNAME) - -ifneq "$$($$($1_$2_PROG)_INPLACE)" "" -$$(error $$($1_$2_PROG)_INPLACE defined twice) -endif -ifeq "$$($1_$2_TOPDIR)" "YES" -$$($1_$2_PROG)_INPLACE = $$(INPLACE_LIB)/bin/$$($1_$2_PROG) -else -$$($1_$2_PROG)_INPLACE = $$(INPLACE_BIN)/$$($1_$2_PROG) -endif - -$1_$2_INPLACE = $$($$($1_$2_PROG)_INPLACE) - -$(call all-target,$1_$2,$$($1_$2_INPLACE)) - -$(call clean-target,$1,$2,$1/$2 $$($1_$2_INPLACE)) -.PHONY: clean_$1 -clean_$1 : clean_$1_$2 - -ifneq "$$(BINDIST)" "YES" - -$1/$2/$$($1_$2_PROG): $1/$$/$$($1_PERL_SRC) $$$$(unlit_INPLACE) | $$$$(dir $$$$@)/. - $$(call removeFiles,$$@) - echo '#!$$(PERL)' >> $$@ - echo 'my $$$$TARGETPLATFORM = "$$(TARGETPLATFORM)";' >> $$@ - echo 'my $$$$TABLES_NEXT_TO_CODE = "$(GhcEnableTablesNextToCode)";' >> $$@ - cat $$< >> $$@ - -$$($1_$2_INPLACE): $1/$2/$$($1_$2_PROG) | $$$$(dir $$$$@)/. - "$$(CP)" $$< $$@ - $$(EXECUTABLE_FILE) $$@ -endif - -ifeq "$$($1_$2_INSTALL)" "YES" -# Don't add to INSTALL_BINS or INSTALL_LIBEXECS, because they will get -# stripped when calling 'make install-strip', and stripping a Perl script -# doesn't work. -ifeq "$$($1_$2_TOPDIR)" "YES" -INSTALL_LIBEXEC_SCRIPTS += $$($1_$2_INPLACE) -else -INSTALL_SCRIPTS += $$($1_$2_INPLACE) -endif -endif - -$(call profEnd, build-perl($1,$2)) -endef diff --git a/rules/distdir-opts.mk b/rules/distdir-opts.mk index 6cabac35d2..b8f10bb2ca 100644 --- a/rules/distdir-opts.mk +++ b/rules/distdir-opts.mk @@ -89,14 +89,6 @@ $1_$2_ALL_HAPPY_OPTS = \ $$($1_$2_HAPPY_OPTS) \ $$(EXTRA_HAPPY_OPTS) -# We don't bother splitting the bootstrap packages (built with stage 0) -ifeq "$$($1_$2_SplitObjs)" "" -ifeq "$$(SplitObjs) $3" "YES 1" -$1_$2_SplitObjs = YES -else -$1_$2_SplitObjs = NO -endif -endif # Disable split sections when building with stage0, it won't be supported yet # and it's probably not very relevant anyway (smaller stage1 ghc?). ifeq "$$($1_$2_SplitSections)" "" diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk index 9166abc378..de2e45d4b9 100644 --- a/rules/distdir-way-opts.mk +++ b/rules/distdir-way-opts.mk @@ -163,7 +163,6 @@ $1_$2_$3_MOST_DIR_HC_OPTS = \ $1_$2_$3_ALL_HC_OPTS = \ -hisuf $$($3_hisuf) -osuf $$($3_osuf) -hcsuf $$($3_hcsuf) \ $$($1_$2_$3_MOST_DIR_HC_OPTS) \ - $$(if $$(findstring YES,$$($1_$2_SplitObjs)),$$(if $$(findstring dyn,$3),,-split-objs),) \ $$(if $$(findstring YES,$$($1_$2_SplitSections)),$$(if $$(findstring dyn,$3),,-split-sections),) \ $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),$$(if $$(findstring v,$3),-dynamic-too)) diff --git a/utils/haddock b/utils/haddock -Subproject 8459c600e0f6da3f85abefdefe651bbe3ed3da4 +Subproject 07f2ca98fd4249dc6ebad053bd6aef90c814efe |