Skip to content
Commits on Source (2)
ghc (8.4.3+dfsg1-5) UNRELEASED; urgency=medium
ghc (8.4.4+dfsg1-1) unstable; urgency=medium
* New upstream release
* Refresh patches to apply cleanly on new upstream
* Apply patch to build on GNU/kFreeBSD (Closes: #913140)
* Backport upstream patch to allow GHC to build on arm*
-- Ilias Tsitsimpis <iliastsi@debian.org> Wed, 07 Nov 2018 14:41:11 +0200
-- Ilias Tsitsimpis <iliastsi@debian.org> Fri, 30 Nov 2018 12:11:18 +0200
ghc (8.4.3+dfsg1-4) unstable; urgency=medium
......
Description: with new ghc 8.4.3, the armel situation seems to have improved,
apply this patch unconditionally.
#Description: Revert ghci ARM improvements (ticket #10375) on armel
# This patch reverts a change which improved ghci on ARM (see
# ghc ticket #10375). While the change fixed ghci on armhf, it
# actually resulted in the ghc package FTBFS on armel since the
# changes introduced made ghc incompatible with this architecture
# (ticket #11058). As a temporary workaround, we revert this particular
# change when ghc is built on armel. For this reason, this patch
# is not applied using the series file but only selectively on
# armel with the help of debian/rules.
# .
#
#Index: ghc-8.4.1/aclocal.m4
#===================================================================
#--- ghc-8.4.1.orig/aclocal.m4
#+++ ghc-8.4.1/aclocal.m4
#@@ -651,15 +651,8 @@
# $3="$$3 -D_HPUX_SOURCE"
# $5="$$5 -D_HPUX_SOURCE"
# ;;
#- arm*linux*)
#- # On arm/linux and arm/android, tell gcc to generate Arm
#- # instructions (ie not Thumb).
#- $2="$$2 -marm"
#- $3="$$3 -Wl,-z,noexecstack"
#- $4="$$4 -z noexecstack"
#- ;;
#-
#- aarch64*linux*)
#+ arm*linux* | \
#+ aarch64*linux* )
# $3="$$3 -Wl,-z,noexecstack"
# $4="$$4 -z noexecstack"
# ;;
#Index: ghc-8.4.1/libraries/ghci/GHCi/InfoTable.hsc
#===================================================================
#--- ghc-8.4.1.orig/libraries/ghci/GHCi/InfoTable.hsc
#+++ ghc-8.4.1/libraries/ghci/GHCi/InfoTable.hsc
#@@ -245,17 +245,17 @@
# , fromIntegral ((w64 `shiftR` 32) .&. 0x0000FFFF) ]
#
# ArchARM { } ->
#- -- Generates Arm sequence,
#+ -- Generates Thumb sequence,
# -- ldr r1, [pc, #0]
# -- bx r1
# --
# -- which looks like:
# -- 00000000 <.addr-0x8>:
#- -- 0: 00109fe5 ldr r1, [pc] ; 8 <.addr>
#- -- 4: 11ff2fe1 bx r1
#+ -- 0: 4900 ldr r1, [pc] ; 8 <.addr>
#+ -- 4: 4708 bx r1
# let w32 = fromIntegral (funPtrToInt a) :: Word32
#- in Left [ 0x00, 0x10, 0x9f, 0xe5
#- , 0x11, 0xff, 0x2f, 0xe1
#+ in Left [ 0x49, 0x00
#+ , 0x47, 0x08
# , byte0 w32, byte1 w32, byte2 w32, byte3 w32]
#
# ArchARM64 { } ->
Index: b/llvm-targets
===================================================================
--- a/llvm-targets
......
From e4003b6dc6a84d870116de9f47057c15b1576f36 Mon Sep 17 00:00:00 2001
From: Guillaume GARDET <guillaume.gardet@opensuse.org>
Date: Fri, 18 May 2018 08:56:28 +0200
Subject: [PATCH] llvm-targets: Add versioned ARM targets
Namely armv6l-unknown-linux-gnueabihf and
armv7l-unknown-linux-gnueabihf.
---
llvm-targets | 4 +++-
utils/llvm-targets/gen-data-layout.sh | 4 ++--
2 files changed, 5 insertions(+), 3 deletions(-)
Index: b/llvm-targets
===================================================================
--- a/llvm-targets
+++ b/llvm-targets
@@ -3,10 +3,12 @@
,("x86_64-unknown-windows", ("e-m:w-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
,("arm-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))
,("armv6-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1136jf-s", "+strict-align"))
+,("armv6l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))
,("armv7-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))
+,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))
+,("armv7l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))
,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon"))
,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon"))
-,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))
,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
Index: b/utils/llvm-targets/gen-data-layout.sh
===================================================================
--- a/utils/llvm-targets/gen-data-layout.sh
+++ b/utils/llvm-targets/gen-data-layout.sh
@@ -18,7 +18,7 @@
# Target sets
WINDOWS_x86="i386-unknown-windows i686-unknown-windows x86_64-unknown-windows"
-LINUX_ARM="arm-unknown-linux-gnueabihf armv6-unknown-linux-gnueabihf armv7-unknown-linux-gnueabihf aarch64-unknown-linux-gnu aarch64-unknown-linux armv7a-unknown-linux-gnueabi"
+LINUX_ARM="arm-unknown-linux-gnueabihf armv6-unknown-linux-gnueabihf armv7-unknown-linux-gnueabihf aarch64-unknown-linux-gnu aarch64-unknown-linux armv7a-unknown-linux-gnueabi armv7l-unknown-linux-gnueabihf"
LINUX_x86="i386-unknown-linux-gnu i386-unknown-linux x86_64-unknown-linux-gnu x86_64-unknown-linux"
ANDROID="armv7-unknown-linux-androideabi aarch64-unknown-linux-android"
QNX="arm-unknown-nto-qnx-eabi"
commit 377fe39888b1c711d15c94583ec83680d8ae7bf4
Author: Ben Gamari <ben@smart-cactus.org>
Date: Tue Oct 30 11:12:46 2018 -0400
Revert "Multiple fixes / improvements for LLVM backend"
This reverts commit 73273be476a8cc6c13368660b042b3b0614fd928.
Unfortunately we were unable to come to a fix that didn't sacrifice the
ability to bootstrap GHC using the LLVM backend. Reverting for 8.6.2.
Index: b/compiler/llvmGen/Llvm/Types.hs
===================================================================
--- 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 "readnone"
+ ppr ReadNone = text "readnon"
ppr ReadOnly = text "readonly"
ppr Ssp = text "ssp"
ppr SspReq = text "ssqreq"
Index: b/compiler/llvmGen/LlvmCodeGen/Base.hs
===================================================================
--- 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, padLiveArgs, isSSE,
+ llvmPtrBits, tysToParams, llvmFunSection,
strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
getGlobalPtr, generateExternDecls,
@@ -58,8 +58,6 @@ import ErrUtils
import qualified Stream
import Control.Monad (ap)
-import Data.List (sort)
-import Data.Maybe (mapMaybe)
-- ----------------------------------------------------------------------------
-- * Some Data Types
@@ -149,58 +147,16 @@ llvmFunSection dflags lbl
-- | A Function's arguments
llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]
llvmFunArgs dflags live =
- map (lmGlobalRegArg dflags) (filter isPassed allRegs)
+ map (lmGlobalRegArg dflags) (filter isPassed (activeStgRegs platform))
where platform = targetPlatform dflags
- allRegs = activeStgRegs platform
- paddedLive = map (\(_,r) -> r) $ padLiveArgs live
- isLive r = r `elem` alwaysLive || r `elem` paddedLive
+ isLive r = not (isSSE r) || r `elem` alwaysLive || r `elem` live
isPassed r = not (isSSE r) || isLive r
-
-
-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.
-
+ isSSE (FloatReg _) = True
+ isSSE (DoubleReg _) = True
+ isSSE (XmmReg _) = True
+ isSSE (YmmReg _) = True
+ isSSE (ZmmReg _) = True
+ isSSE _ = False
-- | Llvm standard fun attributes
llvmStdFunAttrs :: [LlvmFuncAttr]
Index: b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
===================================================================
--- 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 )
+import CodeGen.Platform ( activeStgRegs, callerSaves )
import CLabel
import Cmm
import PprCmm
@@ -211,6 +211,7 @@ genCall t@(PrimTarget (MO_Prefetch_Data
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)
@@ -293,6 +294,7 @@ 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 []
@@ -444,6 +446,7 @@ genCall target res args = runStmtsDecls
| never_returns = statement $ Unreachable
| otherwise = return ()
+ doTrashStmts
-- make the actual call
case retTy of
@@ -1756,9 +1759,12 @@ genLit _ CmmHighStackMark
funPrologue :: LiveGlobalRegs -> [CmmBlock] -> LlvmM StmtData
funPrologue live cmmBlocks = do
+ trash <- getTrashRegs
let getAssignedRegs :: CmmNode O O -> [CmmReg]
getAssignedRegs (CmmAssign reg _) = [reg]
- getAssignedRegs (CmmUnsafeForeignCall _ rs _) = map CmmLocal rs
+ -- 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 _ = []
getRegsBlock (_, body, _) = concatMap getAssignedRegs $ blockToList body
assignedRegs = nub $ concatMap (getRegsBlock . blockSplit) cmmBlocks
@@ -1788,9 +1794,14 @@ funPrologue live cmmBlocks = do
funEpilogue :: LiveGlobalRegs -> LlvmM ([LlvmVar], LlvmStatements)
funEpilogue live = do
- -- the bool indicates whether the register is padding.
- let alwaysNeeded = map (\r -> (False, r)) alwaysLive
- livePadded = alwaysNeeded ++ padLiveArgs live
+ -- 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
-- Set to value or "undef" depending on whether the register is
-- actually live
@@ -1802,17 +1813,39 @@ funEpilogue live = do
let ty = (pLower . getVarType $ lmGlobalRegVar dflags r)
return (Just $ LMLitVar $ LMUndefLit ty, nilOL)
platform <- getDynFlag targetPlatform
- 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
+ loads <- flip mapM (activeStgRegs platform) $ \r -> case () of
+ _ | r `elem` liveRegs -> loadExpr r
+ | not (isSSE r) -> 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
@@ -1934,3 +1967,7 @@ 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
Index: b/compiler/main/DriverPipeline.hs
===================================================================
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1465,7 +1465,7 @@ runPhase (RealPhase LlvmOpt) input_fn df
-- 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 -lower-expect"
+ 0 -> "-mem2reg -globalopt"
1 -> "-O1 -globalopt"
_ -> "-O2"
......@@ -5,13 +5,13 @@ hurd.diff
buildpath-abi-stability.patch
x32-use-native-x86_64-insn.patch
use-stage1-binaries-for-install.patch
llvm-targets-Add-versioned-ARM-targets.patch
llvm-arm-unknown-linux-gnueabi.patch
bsymbolic-only-for-registerised.patch
use-llvm-6.0.patch
e175aaf6918bb2b497b83618dc4c270a0d231a1c.patch
risc-support.patch
armel-revert-ghci-fixes.patch
fix-build-using-unregisterized-v8.2
add_-latomic_to_ghc-prim
haddock-out-of-memory.patch
kfreebsd-aclocal.m4
revert-llvm-fixes