From 7cb427ad37f482776eb56cf82a447ce1a1cfe7fb Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Fri, 19 Oct 2018 16:13:50 +0900 Subject: [PATCH] revert upstream llvm changes (6e361d89/ghc) https://ghc.haskell.org/trac/ghc/ticket/15780 --- ...1d895dda4600a85e01c72ff219474b5c7190.patch | 277 ++++++++++++++++++ ghc.spec | 8 + 2 files changed, 285 insertions(+) create mode 100644 6e361d895dda4600a85e01c72ff219474b5c7190.patch diff --git a/6e361d895dda4600a85e01c72ff219474b5c7190.patch b/6e361d895dda4600a85e01c72ff219474b5c7190.patch new file mode 100644 index 0000000..9f2e86a --- /dev/null +++ b/6e361d895dda4600a85e01c72ff219474b5c7190.patch @@ -0,0 +1,277 @@ +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/ghc.spec b/ghc.spec index 9549314..96abe51 100644 --- a/ghc.spec +++ b/ghc.spec @@ -69,6 +69,10 @@ Patch12: ghc-armv7-VFPv3D16--NEON.patch # https://ghc.haskell.org/trac/ghc/ticket/15689 Patch15: ghc-warnings.mk-CC-Wall.patch +# revert 8.4.4 llvm changes +# https://ghc.haskell.org/trac/ghc/ticket/15780 +Patch16: https://github.com/ghc/ghc/commit/6e361d895dda4600a85e01c72ff219474b5c7190.patch + # Debian patches: Patch24: buildpath-abi-stability.patch Patch26: no-missing-haddock-file-warning.patch @@ -291,6 +295,10 @@ rm -r libffi-tarballs %patch15 -p1 -b .orig %endif +%ifarch armv7hl aarch64 +%patch16 -p1 -b .orig -R +%endif + %patch24 -p1 -b .orig %patch26 -p1 -b .orig %patch28 -p1 -b .orig