diff --git a/296f25fa5f0fce033b529547e0658076e26f4cda.patch b/296f25fa5f0fce033b529547e0658076e26f4cda.patch deleted file mode 100644 index 813c500..0000000 --- a/296f25fa5f0fce033b529547e0658076e26f4cda.patch +++ /dev/null @@ -1,39 +0,0 @@ -From 296f25fa5f0fce033b529547e0658076e26f4cda Mon Sep 17 00:00:00 2001 -From: Adam Sandberg Ericsson -Date: Wed, 28 Apr 2021 20:11:52 +0100 -Subject: [PATCH] rts: export allocateWrite, freeWrite and markExec #19763 - -(cherry picked from commit 2d2985a79eec3d6ae9aee96b264c97c2b158f196) ---- - rts/RtsSymbols.c | 10 ++++++++++ - 1 file changed, 10 insertions(+) - -diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c -index 9ca696c27c4..d5b8cc5fece 100644 ---- a/rts/RtsSymbols.c -+++ b/rts/RtsSymbols.c -@@ -539,11 +539,21 @@ - #define RTS_PROF_SYMBOLS /* empty */ - #endif - -+#if RTS_LINKER_USE_MMAP -+#define RTS_LINKER_USE_MMAP_SYMBOLS \ -+ SymI_HasProto(allocateWrite) \ -+ SymI_HasProto(freeWrite) \ -+ SymI_HasProto(markExec) -+#else -+#define RTS_LINKER_USE_MMAP_SYMBOLS /* empty */ -+#endif -+ - #define RTS_SYMBOLS \ - Maybe_Stable_Names \ - RTS_TICKY_SYMBOLS \ - RTS_PROF_SYMBOLS \ - RTS_LIBDW_SYMBOLS \ -+ RTS_LINKER_USE_MMAP_SYMBOLS \ - SymI_HasProto(StgReturn) \ - SymI_HasProto(stg_gc_noregs) \ - SymI_HasProto(stg_ret_v_info) \ --- -GitLab - diff --git a/6e361d895dda4600a85e01c72ff219474b5c7190.patch b/6e361d895dda4600a85e01c72ff219474b5c7190.patch deleted file mode 100644 index 9f2e86a..0000000 --- a/6e361d895dda4600a85e01c72ff219474b5c7190.patch +++ /dev/null @@ -1,277 +0,0 @@ -From 6e361d895dda4600a85e01c72ff219474b5c7190 Mon Sep 17 00:00:00 2001 -From: Kavon Farvardin -Date: Thu, 4 Oct 2018 13:44:55 -0400 -Subject: [PATCH] Multiple fixes / improvements for LLVM backend - -- Fix for #13904 -- stop "trashing" callee-saved registers, since it is - not actually doing anything useful. - -- Fix for #14251 -- fixes the calling convention for functions passing - raw SSE-register values by adding padding as needed to get the values - in the right registers. This problem cropped up when some args were - unused an dropped from the live list. - -- Fixed a typo in 'readnone' attribute - -- Added 'lower-expect' pass to level 0 LLVM optimization passes to - improve block layout in LLVM for stack checks, etc. - -Test Plan: `make test WAYS=optllvm` and `make test WAYS=llvm` - -Reviewers: bgamari, simonmar, angerman - -Reviewed By: angerman - -Subscribers: rwbarton, carter - -GHC Trac Issues: #13904, #14251 - -Differential Revision: https://phabricator.haskell.org/D5190 - -(cherry picked from commit adcb5fb47c0942671d409b940d8884daa9359ca4) ---- - compiler/llvmGen/Llvm/Types.hs | 2 +- - compiler/llvmGen/LlvmCodeGen/Base.hs | 62 ++++++++++++++++++++---- - compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 59 +++++----------------- - compiler/main/DriverPipeline.hs | 2 +- - testsuite/tests/codeGen/should_run/all.T | 4 +- - 5 files changed, 67 insertions(+), 62 deletions(-) - -diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs -index 87111499fc0..c1c51afcf0f 100644 ---- a/compiler/llvmGen/Llvm/Types.hs -+++ b/compiler/llvmGen/Llvm/Types.hs -@@ -560,7 +560,7 @@ instance Outputable LlvmFuncAttr where - ppr OptSize = text "optsize" - ppr NoReturn = text "noreturn" - ppr NoUnwind = text "nounwind" -- ppr ReadNone = text "readnon" -+ ppr ReadNone = text "readnone" - ppr ReadOnly = text "readonly" - ppr Ssp = text "ssp" - ppr SspReq = text "ssqreq" -diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs -index 6e20da48c1b..ec91bacc4c8 100644 ---- a/compiler/llvmGen/LlvmCodeGen/Base.hs -+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs -@@ -26,7 +26,7 @@ module LlvmCodeGen.Base ( - - cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy, - llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign, -- llvmPtrBits, tysToParams, llvmFunSection, -+ llvmPtrBits, tysToParams, llvmFunSection, padLiveArgs, isSSE, - - strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm, - getGlobalPtr, generateExternDecls, -@@ -58,6 +58,8 @@ import ErrUtils - import qualified Stream - - import Control.Monad (ap) -+import Data.List (sort) -+import Data.Maybe (mapMaybe) - - -- ---------------------------------------------------------------------------- - -- * Some Data Types -@@ -147,16 +149,58 @@ llvmFunSection dflags lbl - -- | A Function's arguments - llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar] - llvmFunArgs dflags live = -- map (lmGlobalRegArg dflags) (filter isPassed (activeStgRegs platform)) -+ map (lmGlobalRegArg dflags) (filter isPassed allRegs) - where platform = targetPlatform dflags -- isLive r = not (isSSE r) || r `elem` alwaysLive || r `elem` live -+ allRegs = activeStgRegs platform -+ paddedLive = map (\(_,r) -> r) $ padLiveArgs live -+ isLive r = r `elem` alwaysLive || r `elem` paddedLive - isPassed r = not (isSSE r) || isLive r -- isSSE (FloatReg _) = True -- isSSE (DoubleReg _) = True -- isSSE (XmmReg _) = True -- isSSE (YmmReg _) = True -- isSSE (ZmmReg _) = True -- isSSE _ = False -+ -+ -+isSSE :: GlobalReg -> Bool -+isSSE (FloatReg _) = True -+isSSE (DoubleReg _) = True -+isSSE (XmmReg _) = True -+isSSE (YmmReg _) = True -+isSSE (ZmmReg _) = True -+isSSE _ = False -+ -+sseRegNum :: GlobalReg -> Maybe Int -+sseRegNum (FloatReg i) = Just i -+sseRegNum (DoubleReg i) = Just i -+sseRegNum (XmmReg i) = Just i -+sseRegNum (YmmReg i) = Just i -+sseRegNum (ZmmReg i) = Just i -+sseRegNum _ = Nothing -+ -+-- the bool indicates whether the global reg was added as padding. -+-- the returned list is not sorted in any particular order, -+-- but does indicate the set of live registers needed, with SSE padding. -+padLiveArgs :: LiveGlobalRegs -> [(Bool, GlobalReg)] -+padLiveArgs live = allRegs -+ where -+ sseRegNums = sort $ mapMaybe sseRegNum live -+ (_, padding) = foldl assignSlots (1, []) $ sseRegNums -+ allRegs = padding ++ map (\r -> (False, r)) live -+ -+ assignSlots (i, acc) regNum -+ | i == regNum = -- don't need padding here -+ (i+1, acc) -+ | i < regNum = let -- add padding for slots i .. regNum-1 -+ numNeeded = regNum-i -+ acc' = genPad i numNeeded ++ acc -+ in -+ (regNum+1, acc') -+ | otherwise = error "padLiveArgs -- i > regNum ??" -+ -+ genPad start n = -+ take n $ flip map (iterate (+1) start) (\i -> -+ (True, FloatReg i)) -+ -- NOTE: Picking float should be fine for the following reasons: -+ -- (1) Float aliases with all the other SSE register types on -+ -- the given platform. -+ -- (2) The argument is not live anyways. -+ - - -- | Llvm standard fun attributes - llvmStdFunAttrs :: [LlvmFuncAttr] -diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs -index e812dd445f1..a7121b7909a 100644 ---- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs -+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs -@@ -14,7 +14,7 @@ import LlvmCodeGen.Base - import LlvmCodeGen.Regs - - import BlockId --import CodeGen.Platform ( activeStgRegs, callerSaves ) -+import CodeGen.Platform ( activeStgRegs ) - import CLabel - import Cmm - import PprCmm -@@ -211,7 +211,6 @@ genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args - fptr <- liftExprData $ getFunPtr funTy t - argVars' <- castVarsW Signed $ zip argVars argTy - -- doTrashStmts - let argSuffix = [mkIntLit i32 0, mkIntLit i32 localityInt, mkIntLit i32 1] - statement $ Expr $ Call StdCall fptr (argVars' ++ argSuffix) [] - | otherwise = panic $ "prefetch locality level integer must be between 0 and 3, given: " ++ (show localityInt) -@@ -294,7 +293,6 @@ genCall t@(PrimTarget op) [] args - fptr <- getFunPtrW funTy t - argVars' <- castVarsW Signed $ zip argVars argTy - -- doTrashStmts - let alignVal = mkIntLit i32 align - arguments = argVars' ++ (alignVal:isVolVal) - statement $ Expr $ Call StdCall fptr arguments [] -@@ -446,7 +444,6 @@ genCall target res args = runStmtsDecls $ do - | never_returns = statement $ Unreachable - | otherwise = return () - -- doTrashStmts - - -- make the actual call - case retTy of -@@ -1759,12 +1756,9 @@ genLit _ CmmHighStackMark - funPrologue :: LiveGlobalRegs -> [CmmBlock] -> LlvmM StmtData - funPrologue live cmmBlocks = do - -- trash <- getTrashRegs - let getAssignedRegs :: CmmNode O O -> [CmmReg] - getAssignedRegs (CmmAssign reg _) = [reg] -- -- Calls will trash all registers. Unfortunately, this needs them to -- -- be stack-allocated in the first place. -- getAssignedRegs (CmmUnsafeForeignCall _ rs _) = map CmmGlobal trash ++ map CmmLocal rs -+ getAssignedRegs (CmmUnsafeForeignCall _ rs _) = map CmmLocal rs - getAssignedRegs _ = [] - getRegsBlock (_, body, _) = concatMap getAssignedRegs $ blockToList body - assignedRegs = nub $ concatMap (getRegsBlock . blockSplit) cmmBlocks -@@ -1794,14 +1788,9 @@ funPrologue live cmmBlocks = do - funEpilogue :: LiveGlobalRegs -> LlvmM ([LlvmVar], LlvmStatements) - funEpilogue live = do - -- -- Have information and liveness optimisation is enabled? -- let liveRegs = alwaysLive ++ live -- isSSE (FloatReg _) = True -- isSSE (DoubleReg _) = True -- isSSE (XmmReg _) = True -- isSSE (YmmReg _) = True -- isSSE (ZmmReg _) = True -- isSSE _ = False -+ -- the bool indicates whether the register is padding. -+ let alwaysNeeded = map (\r -> (False, r)) alwaysLive -+ livePadded = alwaysNeeded ++ padLiveArgs live - - -- Set to value or "undef" depending on whether the register is - -- actually live -@@ -1813,39 +1802,17 @@ funEpilogue live = do - let ty = (pLower . getVarType $ lmGlobalRegVar dflags r) - return (Just $ LMLitVar $ LMUndefLit ty, nilOL) - platform <- getDynFlag targetPlatform -- loads <- flip mapM (activeStgRegs platform) $ \r -> case () of -- _ | r `elem` liveRegs -> loadExpr r -- | not (isSSE r) -> loadUndef r -+ let allRegs = activeStgRegs platform -+ loads <- flip mapM allRegs $ \r -> case () of -+ _ | (False, r) `elem` livePadded -+ -> loadExpr r -- if r is not padding, load it -+ | not (isSSE r) || (True, r) `elem` livePadded -+ -> loadUndef r - | otherwise -> return (Nothing, nilOL) - - let (vars, stmts) = unzip loads - return (catMaybes vars, concatOL stmts) - -- ---- | A series of statements to trash all the STG registers. ---- ---- In LLVM we pass the STG registers around everywhere in function calls. ---- So this means LLVM considers them live across the entire function, when ---- in reality they usually aren't. For Caller save registers across C calls ---- the saving and restoring of them is done by the Cmm code generator, ---- using Cmm local vars. So to stop LLVM saving them as well (and saving ---- all of them since it thinks they're always live, we trash them just ---- before the call by assigning the 'undef' value to them. The ones we ---- need are restored from the Cmm local var and the ones we don't need ---- are fine to be trashed. --getTrashStmts :: LlvmM LlvmStatements --getTrashStmts = do -- regs <- getTrashRegs -- stmts <- flip mapM regs $ \ r -> do -- reg <- getCmmReg (CmmGlobal r) -- let ty = (pLower . getVarType) reg -- return $ Store (LMLitVar $ LMUndefLit ty) reg -- return $ toOL stmts -- --getTrashRegs :: LlvmM [GlobalReg] --getTrashRegs = do plat <- getLlvmPlatform -- return $ filter (callerSaves plat) (activeStgRegs plat) -- - -- | Get a function pointer to the CLabel specified. - -- - -- This is for Haskell functions, function type is assumed, so doesn't work -@@ -1967,7 +1934,3 @@ getCmmRegW = lift . getCmmReg - genLoadW :: Atomic -> CmmExpr -> CmmType -> WriterT LlvmAccum LlvmM LlvmVar - genLoadW atomic e ty = liftExprData $ genLoad atomic e ty - --doTrashStmts :: WriterT LlvmAccum LlvmM () --doTrashStmts = do -- stmts <- lift getTrashStmts -- tell $ LlvmAccum stmts mempty -diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs -index 86dd913461c..f4d5e7f553c 100644 ---- a/compiler/main/DriverPipeline.hs -+++ b/compiler/main/DriverPipeline.hs -@@ -1465,7 +1465,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags - -- we always (unless -optlo specified) run Opt since we rely on it to - -- fix up some pretty big deficiencies in the code we generate - llvmOpts = case optLevel dflags of -- 0 -> "-mem2reg -globalopt" -+ 0 -> "-mem2reg -globalopt -lower-expect" - 1 -> "-O1 -globalopt" - _ -> "-O2" - diff --git a/fix-build-using-unregisterized-v8.2.patch b/fix-build-using-unregisterized-v8.2.patch deleted file mode 100644 index 29d7b49..0000000 --- a/fix-build-using-unregisterized-v8.2.patch +++ /dev/null @@ -1,51 +0,0 @@ -Description: Allow unregisterised ghc-8.2 to build newer GHC - Commit b68697e579d38ca29c2b84377dc2affa04659a28 introduced a regression - stopping existing unregisteristed compilers from being used to compile a newer - version of GHC. The problem is that the bootstrap compiler uses the newer Stg.h - where EB_, IB_, etc, definitions have changed resulting in the following error: -. - error: conflicting types for 'ghc_GhcPrelude_zdtrModule4_bytes' - note: in definition of macro 'EB_' - #define EB_(X) extern const char X[] - note: previous definition of 'ghc_GhcPrelude_zdtrModule4_bytes' was here - char ghc_GhcPrelude_zdtrModule4_bytes[] = "ghc"; -. - For more information about the problem, see https://phabricator.haskell.org/D4114. -. - This patch is a rework of https://phabricator.haskell.org/D3741. - It modifies Stg.h to include the old definitions, if a compiler older than - 8.4 is being used. -. - This patch can be removed, once ghc-8.2 is no longer the bootstrap compiler. -Author: Ilias Tsitsimpis -Bug: https://ghc.haskell.org/trac/ghc/ticket/15201 - -Index: b/includes/Stg.h -=================================================================== ---- a/includes/Stg.h -+++ b/includes/Stg.h -@@ -232,6 +232,16 @@ typedef StgInt I_; - typedef StgWord StgWordArray[]; - typedef StgFunPtr F_; - -+#if __GLASGOW_HASKELL__ < 804 -+#define EB_(X) extern char X[] -+#define IB_(X) static char X[] -+#define EI_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) -+#define II_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) -+#define IF_(f) static StgFunPtr GNUC3_ATTRIBUTE(used) f(void) -+#define FN_(f) StgFunPtr f(void) -+#define EF_(f) StgFunPtr f(void) /* External Cmm functions */ -+#define EFF_(f) void f() /* See Note [External function prototypes] */ -+#else - /* byte arrays (and strings): */ - #define EB_(X) extern const char X[] - #define IB_(X) static const char X[] -@@ -250,6 +260,7 @@ typedef StgFunPtr F_; - #define EF_(f) StgFunPtr f(void) /* External Cmm functions */ - /* foreign functions: */ - #define EFF_(f) void f() /* See Note [External function prototypes] */ -+#endif /* __GLASGOW_HASKELL__ < 804 */ - - /* Note [External function prototypes] See Trac #8965, #11395 - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/fix-build-using-unregisterized-v8.4.patch b/fix-build-using-unregisterized-v8.4.patch deleted file mode 100644 index c524733..0000000 --- a/fix-build-using-unregisterized-v8.4.patch +++ /dev/null @@ -1,58 +0,0 @@ -Description: Allow unregisterised ghc-8.4 to build newer GHC - Commit 4075656e8bb introduced a regression stopping existing unregisteristed - compilers from being able to compile newer versions of GHC. The problem is - that the bootstrap compiler uses the newer `rts/storage/ClosureTypes.h` file - where some defines have been renamed, resulting in the following error: -. - error: ‘stg_MUT_ARR_PTRS_FROZEN0_info’ undeclared (first use in this function); did you mean ‘stg_MUT_ARR_PTRS_FROZEN_DIRTY_info’? -. - For more information, see https://gitlab.haskell.org/ghc/ghc/issues/15913. -. - This patch can be removed, once ghc-8.4 is no longer the bootstrap compiler. -Author: Ilias Tsitsimpis -Bug: https://gitlab.haskell.org/ghc/ghc/issues/15913 -Bug-Debian: https://bugs.debian.org/932941 - -Index: b/includes/rts/storage/ClosureTypes.h -=================================================================== ---- a/includes/rts/storage/ClosureTypes.h -+++ b/includes/rts/storage/ClosureTypes.h -@@ -82,5 +82,11 @@ - #define SMALL_MUT_ARR_PTRS_DIRTY 60 - #define SMALL_MUT_ARR_PTRS_FROZEN_DIRTY 61 - #define SMALL_MUT_ARR_PTRS_FROZEN_CLEAN 62 -+#if __GLASGOW_HASKELL__ < 806 -+#define SMALL_MUT_ARR_PTRS_FROZEN0 SMALL_MUT_ARR_PTRS_FROZEN_DIRTY -+#define SMALL_MUT_ARR_PTRS_FROZEN SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -+#define MUT_ARR_PTRS_FROZEN0 MUT_ARR_PTRS_FROZEN_DIRTY -+#define MUT_ARR_PTRS_FROZEN MUT_ARR_PTRS_FROZEN_CLEAN -+#endif - #define COMPACT_NFDATA 63 - #define N_CLOSURE_TYPES 64 -Index: b/includes/stg/MiscClosures.h -=================================================================== ---- a/includes/stg/MiscClosures.h -+++ b/includes/stg/MiscClosures.h -@@ -116,12 +116,22 @@ RTS_ENTRY(stg_ARR_WORDS); - RTS_ENTRY(stg_MUT_ARR_WORDS); - RTS_ENTRY(stg_MUT_ARR_PTRS_CLEAN); - RTS_ENTRY(stg_MUT_ARR_PTRS_DIRTY); -+#if __GLASGOW_HASKELL__ < 806 -+RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN); -+RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN0); -+#else - RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN_CLEAN); - RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN_DIRTY); -+#endif - RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_CLEAN); - RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_DIRTY); -+#if __GLASGOW_HASKELL__ < 806 -+RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN); -+RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN0); -+#else - RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN); - RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY); -+#endif - RTS_ENTRY(stg_MUT_VAR_CLEAN); - RTS_ENTRY(stg_MUT_VAR_DIRTY); - RTS_ENTRY(stg_END_TSO_QUEUE);