pool/ghc
SHA256
4
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

osc copypac from project:devel:languages:haskell:ghc-8.4.x package:ghc revision:1, using keep-link

Browse Source 
OBS-URL: https://build.opensuse.org/package/show/devel:languages:haskell/ghc?expand=0&rev=260
This commit is contained in:
Peter Simons 2018-05-14 13:15:35 +00:00 committed by Git OBS Bridge
parent 3f49995d0d
commit 61cedda0f1
12 changed files with 76 additions and 746 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
0001-PPC-CodeGen-fix-lwa-instruction-generation.patch
View File

@ -1,22 +0,0 @@
From ff48b3e3fd90e0328921f5e86460aba3ff217002 Mon Sep 17 00:00:00 2001
From: Peter Trommler <ptrommler@acm.org>
Date: Mon, 25 Jan 2016 20:32:44 +0100
Subject: [PATCH] PPC/CodeGen: fix lwa instruction generation
---
compiler/nativeGen/PPC/CodeGen.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
Index: ghc-8.0.2/compiler/nativeGen/PPC/CodeGen.hs
===================================================================
--- ghc-8.0.2.orig/compiler/nativeGen/PPC/CodeGen.hs
+++ ghc-8.0.2/compiler/nativeGen/PPC/CodeGen.hs
@@ -466,7 +466,7 @@ getRegister' _ (CmmMachOp (MO_SS_Conv W1
return (Any II64 (\dst -> addr_code `snocOL` LA II16 dst addr))
getRegister' _ (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad mem _]) = do
- Amode addr addr_code <- getAmode D mem
+ Amode addr addr_code <- getAmode DS mem -- lwa is DS-form
return (Any II64 (\dst -> addr_code `snocOL` LD II32 dst addr))
getRegister' _ (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad mem _]) = do

561
0001-PPC-Implement-Atomic-operations.patch
View File

@ -1,561 +0,0 @@
Index: ghc-8.2.1/compiler/nativeGen/PPC/CodeGen.hs
===================================================================
--- ghc-8.2.1.orig/compiler/nativeGen/PPC/CodeGen.hs
+++ ghc-8.2.1/compiler/nativeGen/PPC/CodeGen.hs
@@ -160,8 +160,8 @@ stmtToInstrs stmt = do
-> genCCall target result_regs args
CmmBranch id -> genBranch id
- CmmCondBranch arg true false _ -> do
- b1 <- genCondJump true arg
+ CmmCondBranch arg true false prediction -> do
+ b1 <- genCondJump true arg prediction
b2 <- genBranch false
return (b1 `appOL` b2)
CmmSwitch arg ids -> do dflags <- getDynFlags
@@ -1069,11 +1069,12 @@ comparison to do.
genCondJump
:: BlockId -- the branch target
-> CmmExpr -- the condition on which to branch
+ -> Maybe Bool
-> NatM InstrBlock
-genCondJump id bool = do
+genCondJump id bool prediction = do
CondCode _ cond code <- getCondCode bool
- return (code `snocOL` BCC cond id)
+ return (code `snocOL` BCC cond id prediction)
@@ -1097,6 +1098,78 @@ genCCall (PrimTarget MO_Touch) _ _
genCCall (PrimTarget (MO_Prefetch_Data _)) _ _
= return $ nilOL
+genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
+ = do dflags <- getDynFlags
+ let platform = targetPlatform dflags
+ fmt = intFormat width
+ reg_dst = getRegisterReg platform (CmmLocal dst)
+ (instr, n_code) <- case amop of
+ AMO_Add -> getSomeRegOrImm ADD True reg_dst
+ AMO_Sub -> case n of
+ CmmLit (CmmInt i _)
+ | Just imm <- makeImmediate width True (-i)
+ -> return (ADD reg_dst reg_dst (RIImm imm), nilOL)
+ _
+ -> do
+ (n_reg, n_code) <- getSomeReg n
+ return (SUBF reg_dst n_reg reg_dst, n_code)
+ AMO_And -> getSomeRegOrImm AND False reg_dst
+ AMO_Nand -> do (n_reg, n_code) <- getSomeReg n
+ return (NAND reg_dst reg_dst n_reg, n_code)
+ AMO_Or -> getSomeRegOrImm OR False reg_dst
+ AMO_Xor -> getSomeRegOrImm XOR False reg_dst
+ Amode addr_reg addr_code <- getAmodeIndex addr
+ lbl_retry <- getBlockIdNat
+ return $ n_code `appOL` addr_code
+ `appOL` toOL [ HWSYNC
+ , BCC ALWAYS lbl_retry Nothing
+ , NEWBLOCK lbl_retry
+ , LDR fmt reg_dst addr_reg
+ , instr
+ , STC fmt reg_dst addr_reg
+ , BCC NE lbl_retry (Just False)
+ , ISYNC
+ ]
+ where
+ getAmodeIndex (CmmMachOp (MO_Add _) [x, y])
+ = do
+ (regX, codeX) <- getSomeReg x
+ (regY, codeY) <- getSomeReg y
+ return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
+ getAmodeIndex other
+ = do
+ (reg, code) <- getSomeReg other
+ return (Amode (AddrRegReg r0 reg) code) -- NB: r0 is 0 here!
+ getSomeRegOrImm op sign dst
+ = case n of
+ CmmLit (CmmInt i _) | Just imm <- makeImmediate width sign i
+ -> return (op dst dst (RIImm imm), nilOL)
+ _
+ -> do
+ (n_reg, n_code) <- getSomeReg n
+ return (op dst dst (RIReg n_reg), n_code)
+
+genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]
+ = do dflags <- getDynFlags
+ let platform = targetPlatform dflags
+ fmt = intFormat width
+ reg_dst = getRegisterReg platform (CmmLocal dst)
+ form = if widthInBits width == 64 then DS else D
+ Amode addr_reg addr_code <- getAmode form addr
+ lbl_end <- getBlockIdNat
+ return $ addr_code `appOL` toOL [ HWSYNC
+ , LD fmt reg_dst addr_reg
+ , CMP fmt reg_dst (RIReg reg_dst)
+ , BCC NE lbl_end (Just False)
+ , BCC ALWAYS lbl_end Nothing
+ , NEWBLOCK lbl_end
+ , ISYNC
+ ]
+
+genCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do
+ code <- assignMem_IntCode (intFormat width) addr val
+ return $ unitOL(HWSYNC) `appOL` code
+
genCCall (PrimTarget (MO_Clz width)) [dst] [src]
= do dflags <- getDynFlags
let platform = targetPlatform dflags
@@ -1109,17 +1182,17 @@ genCCall (PrimTarget (MO_Clz width)) [ds
lbl3 <- getBlockIdNat
let vr_hi = getHiVRegFromLo vr_lo
cntlz = toOL [ CMPL II32 vr_hi (RIImm (ImmInt 0))
- , BCC NE lbl2
- , BCC ALWAYS lbl1
+ , BCC NE lbl2 Nothing
+ , BCC ALWAYS lbl1 Nothing
, NEWBLOCK lbl1
, CNTLZ II32 reg_dst vr_lo
, ADD reg_dst reg_dst (RIImm (ImmInt 32))
- , BCC ALWAYS lbl3
+ , BCC ALWAYS lbl3 Nothing
, NEWBLOCK lbl2
, CNTLZ II32 reg_dst vr_hi
- , BCC ALWAYS lbl3
+ , BCC ALWAYS lbl3 Nothing
, NEWBLOCK lbl3
]
@@ -1166,8 +1239,8 @@ genCCall (PrimTarget (MO_Ctz width)) [ds
cnttzlo <- cnttz format reg_dst vr_lo
let vr_hi = getHiVRegFromLo vr_lo
cnttz64 = toOL [ CMPL format vr_lo (RIImm (ImmInt 0))
- , BCC NE lbl2
- , BCC ALWAYS lbl1
+ , BCC NE lbl2 Nothing
+ , BCC ALWAYS lbl1 Nothing
, NEWBLOCK lbl1
, ADD x' vr_hi (RIImm (ImmInt (-1)))
@@ -1175,12 +1248,12 @@ genCCall (PrimTarget (MO_Ctz width)) [ds
, CNTLZ format r' x''
-- 32 + (32 - clz(x''))
, SUBFC reg_dst r' (RIImm (ImmInt 64))
- , BCC ALWAYS lbl3
+ , BCC ALWAYS lbl3 Nothing
, NEWBLOCK lbl2
]
`appOL` cnttzlo `appOL`
- toOL [ BCC ALWAYS lbl3
+ toOL [ BCC ALWAYS lbl3 Nothing
, NEWBLOCK lbl3
]
@@ -1314,21 +1387,21 @@ genCCall target dest_regs argsAndHints
-- rhat = un32 - q1*vn1
, MULL fmt tmp q1 (RIReg vn1)
, SUBF rhat tmp un32
- , BCC ALWAYS again1
+ , BCC ALWAYS again1 Nothing
, NEWBLOCK again1
-- if (q1 >= b || q1*vn0 > b*rhat + un1)
, CMPL fmt q1 (RIReg b)
- , BCC GEU then1
- , BCC ALWAYS no1
+ , BCC GEU then1 Nothing
+ , BCC ALWAYS no1 Nothing
, NEWBLOCK no1
, MULL fmt tmp q1 (RIReg vn0)
, SL fmt tmp1 rhat (RIImm (ImmInt half))
, ADD tmp1 tmp1 (RIReg un1)
, CMPL fmt tmp (RIReg tmp1)
- , BCC LEU endif1
- , BCC ALWAYS then1
+ , BCC LEU endif1 Nothing
+ , BCC ALWAYS then1 Nothing
, NEWBLOCK then1
-- q1 = q1 - 1
@@ -1337,8 +1410,8 @@ genCCall target dest_regs argsAndHints
, ADD rhat rhat (RIReg vn1)
-- if (rhat < b) goto again1
, CMPL fmt rhat (RIReg b)
- , BCC LTT again1
- , BCC ALWAYS endif1
+ , BCC LTT again1 Nothing
+ , BCC ALWAYS endif1 Nothing
, NEWBLOCK endif1
-- un21 = un32*b + un1 - q1*v
@@ -1352,21 +1425,21 @@ genCCall target dest_regs argsAndHints
-- rhat = un21- q0*vn1
, MULL fmt tmp q0 (RIReg vn1)
, SUBF rhat tmp un21
- , BCC ALWAYS again2
+ , BCC ALWAYS again2 Nothing
, NEWBLOCK again2
-- if (q0>b || q0*vn0 > b*rhat + un0)
, CMPL fmt q0 (RIReg b)
- , BCC GEU then2
- , BCC ALWAYS no2
+ , BCC GEU then2 Nothing
+ , BCC ALWAYS no2 Nothing
, NEWBLOCK no2
, MULL fmt tmp q0 (RIReg vn0)
, SL fmt tmp1 rhat (RIImm (ImmInt half))
, ADD tmp1 tmp1 (RIReg un0)
, CMPL fmt tmp (RIReg tmp1)
- , BCC LEU endif2
- , BCC ALWAYS then2
+ , BCC LEU endif2 Nothing
+ , BCC ALWAYS then2 Nothing
, NEWBLOCK then2
-- q0 = q0 - 1
@@ -1375,8 +1448,8 @@ genCCall target dest_regs argsAndHints
, ADD rhat rhat (RIReg vn1)
-- if (rhat<b) goto again2
, CMPL fmt rhat (RIReg b)
- , BCC LTT again2
- , BCC ALWAYS endif2
+ , BCC LTT again2 Nothing
+ , BCC ALWAYS endif2 Nothing
, NEWBLOCK endif2
-- compute remainder
@@ -1906,12 +1979,12 @@ genCCall' dflags gcp target dest_regs ar
MO_BSwap w -> (fsLit $ bSwapLabel w, False)
MO_PopCnt w -> (fsLit $ popCntLabel w, False)
- MO_Clz w -> (fsLit $ clzLabel w, False)
- MO_Ctz w -> (fsLit $ ctzLabel w, False)
- MO_AtomicRMW w amop -> (fsLit $ atomicRMWLabel w amop, False)
+ MO_Clz _ -> unsupported
+ MO_Ctz _ -> unsupported
+ MO_AtomicRMW {} -> unsupported
MO_Cmpxchg w -> (fsLit $ cmpxchgLabel w, False)
- MO_AtomicRead w -> (fsLit $ atomicReadLabel w, False)
- MO_AtomicWrite w -> (fsLit $ atomicWriteLabel w, False)
+ MO_AtomicRead _ -> unsupported
+ MO_AtomicWrite _ -> unsupported
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
@@ -1923,7 +1996,7 @@ genCCall' dflags gcp target dest_regs ar
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
- (MO_Prefetch_Data _ ) -> unsupported
+ MO_Prefetch_Data _ -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop
++ " not supported")
Index: ghc-8.2.1/compiler/nativeGen/PPC/Instr.hs
===================================================================
--- ghc-8.2.1.orig/compiler/nativeGen/PPC/Instr.hs
+++ ghc-8.2.1/compiler/nativeGen/PPC/Instr.hs
@@ -123,7 +123,7 @@ allocMoreStack platform slots (CmmProc i
insert_stack_insns (BasicBlock id insns)
| Just new_blockid <- mapLookup id new_blockmap
- = [ BasicBlock id [alloc, BCC ALWAYS new_blockid]
+ = [ BasicBlock id [alloc, BCC ALWAYS new_blockid Nothing]
, BasicBlock new_blockid block'
]
| otherwise
@@ -139,8 +139,8 @@ allocMoreStack platform slots (CmmProc i
JMP _ -> dealloc : insn : r
BCTR [] Nothing -> dealloc : insn : r
BCTR ids label -> BCTR (map (fmap retarget) ids) label : r
- BCCFAR cond b -> BCCFAR cond (retarget b) : r
- BCC cond b -> BCC cond (retarget b) : r
+ BCCFAR cond b p -> BCCFAR cond (retarget b) p : r
+ BCC cond b p -> BCC cond (retarget b) p : r
_ -> insn : r
-- BL and BCTRL are call-like instructions rather than
-- jumps, and are used only for C calls.
@@ -189,10 +189,12 @@ data Instr
-- Loads and stores.
| LD Format Reg AddrMode -- Load format, dst, src
| LDFAR Format Reg AddrMode -- Load format, dst, src 32 bit offset
+ | LDR Format Reg AddrMode -- Load and reserve format, dst, src
| LA Format Reg AddrMode -- Load arithmetic format, dst, src
| ST Format Reg AddrMode -- Store format, src, dst
| STFAR Format Reg AddrMode -- Store format, src, dst 32 bit offset
| STU Format Reg AddrMode -- Store with Update format, src, dst
+ | STC Format Reg AddrMode -- Store conditional format, src, dst
| LIS Reg Imm -- Load Immediate Shifted dst, src
| LI Reg Imm -- Load Immediate dst, src
| MR Reg Reg -- Move Register dst, src -- also for fmr
@@ -200,8 +202,8 @@ data Instr
| CMP Format Reg RI -- format, src1, src2
| CMPL Format Reg RI -- format, src1, src2
- | BCC Cond BlockId
- | BCCFAR Cond BlockId
+ | BCC Cond BlockId (Maybe Bool)
+ | BCCFAR Cond BlockId (Maybe Bool)
| JMP CLabel -- same as branch,
-- but with CLabel instead of block ID
| MTCTR Reg
@@ -231,6 +233,7 @@ data Instr
| DIV Format Bool Reg Reg Reg
| AND Reg Reg RI -- dst, src1, src2
| ANDC Reg Reg Reg -- AND with complement, dst = src1 & ~ src2
+ | NAND Reg Reg Reg -- dst, src1, src2
| OR Reg Reg RI -- dst, src1, src2
| ORIS Reg Reg Imm -- OR Immediate Shifted dst, src1, src2
| XOR Reg Reg RI -- dst, src1, src2
@@ -271,6 +274,8 @@ data Instr
| MFLR Reg -- move from link register
| FETCHPC Reg -- pseudo-instruction:
-- bcl to next insn, mflr reg
+ | HWSYNC -- heavy weight sync
+ | ISYNC -- instruction synchronize
| LWSYNC -- memory barrier
| NOP -- no operation, PowerPC 64 bit
-- needs this as place holder to
@@ -289,17 +294,19 @@ ppc_regUsageOfInstr platform instr
= case instr of
LD _ reg addr -> usage (regAddr addr, [reg])
LDFAR _ reg addr -> usage (regAddr addr, [reg])
+ LDR _ reg addr -> usage (regAddr addr, [reg])
LA _ reg addr -> usage (regAddr addr, [reg])
ST _ reg addr -> usage (reg : regAddr addr, [])
STFAR _ reg addr -> usage (reg : regAddr addr, [])
STU _ reg addr -> usage (reg : regAddr addr, [])
+ STC _ reg addr -> usage (reg : regAddr addr, [])
LIS reg _ -> usage ([], [reg])
LI reg _ -> usage ([], [reg])
MR reg1 reg2 -> usage ([reg2], [reg1])
CMP _ reg ri -> usage (reg : regRI ri,[])
CMPL _ reg ri -> usage (reg : regRI ri,[])
- BCC _ _ -> noUsage
- BCCFAR _ _ -> noUsage
+ BCC _ _ _ -> noUsage
+ BCCFAR _ _ _ -> noUsage
MTCTR reg -> usage ([reg],[])
BCTR _ _ -> noUsage
BL _ params -> usage (params, callClobberedRegs platform)
@@ -324,6 +331,7 @@ ppc_regUsageOfInstr platform instr
AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
ANDC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
+ NAND reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
ORIS reg1 reg2 _ -> usage ([reg2], [reg1])
XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
@@ -379,17 +387,19 @@ ppc_patchRegsOfInstr instr env
= case instr of
LD fmt reg addr -> LD fmt (env reg) (fixAddr addr)
LDFAR fmt reg addr -> LDFAR fmt (env reg) (fixAddr addr)
+ LDR fmt reg addr -> LDR fmt (env reg) (fixAddr addr)
LA fmt reg addr -> LA fmt (env reg) (fixAddr addr)
ST fmt reg addr -> ST fmt (env reg) (fixAddr addr)
STFAR fmt reg addr -> STFAR fmt (env reg) (fixAddr addr)
STU fmt reg addr -> STU fmt (env reg) (fixAddr addr)
+ STC fmt reg addr -> STC fmt (env reg) (fixAddr addr)
LIS reg imm -> LIS (env reg) imm
LI reg imm -> LI (env reg) imm
MR reg1 reg2 -> MR (env reg1) (env reg2)
CMP fmt reg ri -> CMP fmt (env reg) (fixRI ri)
CMPL fmt reg ri -> CMPL fmt (env reg) (fixRI ri)
- BCC cond lbl -> BCC cond lbl
- BCCFAR cond lbl -> BCCFAR cond lbl
+ BCC cond lbl p -> BCC cond lbl p
+ BCCFAR cond lbl p -> BCCFAR cond lbl p
MTCTR reg -> MTCTR (env reg)
BCTR targets lbl -> BCTR targets lbl
BL imm argRegs -> BL imm argRegs -- argument regs
@@ -416,6 +426,7 @@ ppc_patchRegsOfInstr instr env
AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri)
ANDC reg1 reg2 reg3 -> ANDC (env reg1) (env reg2) (env reg3)
+ NAND reg1 reg2 reg3 -> NAND (env reg1) (env reg2) (env reg3)
OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri)
ORIS reg1 reg2 imm -> ORIS (env reg1) (env reg2) imm
XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri)
@@ -479,8 +490,8 @@ ppc_isJumpishInstr instr
ppc_jumpDestsOfInstr :: Instr -> [BlockId]
ppc_jumpDestsOfInstr insn
= case insn of
- BCC _ id -> [id]
- BCCFAR _ id -> [id]
+ BCC _ id _ -> [id]
+ BCCFAR _ id _ -> [id]
BCTR targets _ -> [id | Just id <- targets]
_ -> []
@@ -491,8 +502,8 @@ ppc_jumpDestsOfInstr insn
ppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
ppc_patchJumpInstr insn patchF
= case insn of
- BCC cc id -> BCC cc (patchF id)
- BCCFAR cc id -> BCCFAR cc (patchF id)
+ BCC cc id p -> BCC cc (patchF id) p
+ BCCFAR cc id p -> BCCFAR cc (patchF id) p
BCTR ids lbl -> BCTR (map (fmap patchF) ids) lbl
_ -> insn
@@ -639,7 +650,7 @@ ppc_mkJumpInstr
-> [Instr]
ppc_mkJumpInstr id
- = [BCC ALWAYS id]
+ = [BCC ALWAYS id Nothing]
-- | Take the source and destination from this reg -> reg move instruction
@@ -668,12 +679,12 @@ makeFarBranches info_env blocks
handleBlock addr (BasicBlock id instrs)
= BasicBlock id (zipWith makeFar [addr..] instrs)
- makeFar _ (BCC ALWAYS tgt) = BCC ALWAYS tgt
- makeFar addr (BCC cond tgt)
+ makeFar _ (BCC ALWAYS tgt _) = BCC ALWAYS tgt Nothing
+ makeFar addr (BCC cond tgt p)
| abs (addr - targetAddr) >= nearLimit
- = BCCFAR cond tgt
+ = BCCFAR cond tgt p
| otherwise
- = BCC cond tgt
+ = BCC cond tgt p
where Just targetAddr = lookupUFM blockAddressMap tgt
makeFar _ other = other
Index: ghc-8.2.1/compiler/nativeGen/PPC/Ppr.hs
===================================================================
--- ghc-8.2.1.orig/compiler/nativeGen/PPC/Ppr.hs
+++ ghc-8.2.1/compiler/nativeGen/PPC/Ppr.hs
@@ -309,11 +309,13 @@ pprImm (HIGHESTA i)
pprAddr :: AddrMode -> SDoc
pprAddr (AddrRegReg r1 r2)
- = pprReg r1 <+> text ", " <+> pprReg r2
-
-pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
-pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
-pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
+ = pprReg r1 <> char ',' <+> pprReg r2
+pprAddr (AddrRegImm r1 (ImmInt i))
+ = hcat [ int i, char '(', pprReg r1, char ')' ]
+pprAddr (AddrRegImm r1 (ImmInteger i))
+ = hcat [ integer i, char '(', pprReg r1, char ')' ]
+pprAddr (AddrRegImm r1 imm)
+ = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
pprSectionAlign :: Section -> SDoc
@@ -449,15 +451,27 @@ pprInstr (LD fmt reg addr) = hcat [
text ", ",
pprAddr addr
]
+
pprInstr (LDFAR fmt reg (AddrRegImm source off)) =
sdocWithPlatform $ \platform -> vcat [
pprInstr (ADDIS (tmpReg platform) source (HA off)),
pprInstr (LD fmt reg (AddrRegImm (tmpReg platform) (LO off)))
]
-
pprInstr (LDFAR _ _ _) =
panic "PPC.Ppr.pprInstr LDFAR: no match"
+pprInstr (LDR fmt reg1 addr) = hcat [
+ text "\tl",
+ case fmt of
+ II32 -> char 'w'
+ II64 -> char 'd'
+ _ -> panic "PPC.Ppr.Instr LDR: no match",
+ text "arx\t",
+ pprReg reg1,
+ text ", ",
+ pprAddr addr
+ ]
+
pprInstr (LA fmt reg addr) = hcat [
char '\t',
text "l",
@@ -507,6 +521,17 @@ pprInstr (STU fmt reg addr) = hcat [
text ", ",
pprAddr addr
]
+pprInstr (STC fmt reg1 addr) = hcat [
+ text "\tst",
+ case fmt of
+ II32 -> char 'w'
+ II64 -> char 'd'
+ _ -> panic "PPC.Ppr.Instr LDR: no match",
+ text "cx.\t",
+ pprReg reg1,
+ text ", ",
+ pprAddr addr
+ ]
pprInstr (LIS reg imm) = hcat [
char '\t',
text "lis",
@@ -568,19 +593,25 @@ pprInstr (CMPL fmt reg ri) = hcat [
RIReg _ -> empty
RIImm _ -> char 'i'
]
-pprInstr (BCC cond blockid) = hcat [
+pprInstr (BCC cond blockid prediction) = hcat [
char '\t',
text "b",
pprCond cond,
+ pprPrediction prediction,
char '\t',
ppr lbl
]
where lbl = mkAsmTempLabel (getUnique blockid)
+ pprPrediction p = case p of
+ Nothing -> empty
+ Just True -> char '+'
+ Just False -> char '-'
-pprInstr (BCCFAR cond blockid) = vcat [
+pprInstr (BCCFAR cond blockid prediction) = vcat [
hcat [
text "\tb",
pprCond (condNegate cond),
+ neg_prediction,
text "\t$+8"
],
hcat [
@@ -589,6 +620,10 @@ pprInstr (BCCFAR cond blockid) = vcat [
]
]
where lbl = mkAsmTempLabel (getUnique blockid)
+ neg_prediction = case prediction of
+ Nothing -> empty
+ Just True -> char '-'
+ Just False -> char '+'
pprInstr (JMP lbl)
-- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
@@ -740,6 +775,7 @@ pprInstr (AND reg1 reg2 (RIImm imm)) = h
]
pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
pprInstr (ANDC reg1 reg2 reg3) = pprLogic (sLit "andc") reg1 reg2 (RIReg reg3)
+pprInstr (NAND reg1 reg2 reg3) = pprLogic (sLit "nand") reg1 reg2 (RIReg reg3)
pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
@@ -921,6 +957,10 @@ pprInstr (FETCHPC reg) = vcat [
hcat [ text "1:\tmflr\t", pprReg reg ]
]
+pprInstr HWSYNC = text "\tsync"
+
+pprInstr ISYNC = text "\tisync"
+
pprInstr LWSYNC = text "\tlwsync"
pprInstr NOP = text "\tnop"

80
0001-Use-__atomic-intrinsics-for-atomicread-write.patch
View File

@ -1,80 +0,0 @@
From 00d1f097680da6ca718600884794128919dbd87d Mon Sep 17 00:00:00 2001
From: Peter Trommler <ptrommler@acm.org>
Date: Thu, 21 Sep 2017 13:42:58 +0200
Subject: [PATCH] Use __atomic* intrinsics for atomicread/write
---
libraries/ghc-prim/cbits/atomic.c | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/libraries/ghc-prim/cbits/atomic.c b/libraries/ghc-prim/cbits/atomic.c
index 2ecbf3461a..e679186394 100644
--- a/libraries/ghc-prim/cbits/atomic.c
+++ b/libraries/ghc-prim/cbits/atomic.c
@@ -265,28 +265,28 @@ extern StgWord hs_atomicread8(StgWord x);
StgWord
hs_atomicread8(StgWord x)
{
- return *(volatile StgWord8 *) x;
+ return __atomic_load_n((StgWord8 *) x, __ATOMIC_SEQ_CST);
}
extern StgWord hs_atomicread16(StgWord x);
StgWord
hs_atomicread16(StgWord x)
{
- return *(volatile StgWord16 *) x;
+ return __atomic_load_n((StgWord16 *) x, __ATOMIC_SEQ_CST);
}
extern StgWord hs_atomicread32(StgWord x);
StgWord
hs_atomicread32(StgWord x)
{
- return *(volatile StgWord32 *) x;
+ return __atomic_load_n((StgWord32 *) x, __ATOMIC_SEQ_CST);
}
extern StgWord64 hs_atomicread64(StgWord x);
StgWord64
hs_atomicread64(StgWord x)
{
- return *(volatile StgWord64 *) x;
+ return __atomic_load_n((StgWord64 *) x, __ATOMIC_SEQ_CST);
}
// AtomicWriteByteArrayOp_Int
@@ -295,26 +295,26 @@ extern void hs_atomicwrite8(StgWord x, StgWord val);
void
hs_atomicwrite8(StgWord x, StgWord val)
{
- *(volatile StgWord8 *) x = (StgWord8) val;
+ __atomic_store_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
extern void hs_atomicwrite16(StgWord x, StgWord val);
void
hs_atomicwrite16(StgWord x, StgWord val)
{
- *(volatile StgWord16 *) x = (StgWord16) val;
+ __atomic_store_n((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
extern void hs_atomicwrite32(StgWord x, StgWord val);
void
hs_atomicwrite32(StgWord x, StgWord val)
{
- *(volatile StgWord32 *) x = (StgWord32) val;
+ __atomic_store_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
extern void hs_atomicwrite64(StgWord x, StgWord64 val);
void
hs_atomicwrite64(StgWord x, StgWord64 val)
{
- *(volatile StgWord64 *) x = (StgWord64) val;
+ __atomic_store_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
}
--
2.12.3

23
D4089.patch
View File

@ -1,23 +0,0 @@
Index: ghc-8.2.1/compiler/ghci/RtClosureInspect.hs
===================================================================
--- ghc-8.2.1.orig/compiler/ghci/RtClosureInspect.hs
+++ ghc-8.2.1/compiler/ghci/RtClosureInspect.hs
@@ -55,6 +55,7 @@ import TysWiredIn
import DynFlags
import Outputable as Ppr
import GHC.Arr ( Array(..) )
+import GHC.Char
import GHC.Exts
import GHC.IO ( IO(..) )
@@ -487,7 +488,9 @@ cPprTermBase y =
repPrim :: TyCon -> [Word] -> SDoc
repPrim t = rep where
rep x
- | t == charPrimTyCon = text $ show (build x :: Char)
+ -- Char# uses native machine words, whereas Char's Storable instance uses
+ -- Int32, so we have to read it as an Int.
+ | t == charPrimTyCon = text $ show (chr (build x :: Int))
| t == intPrimTyCon = text $ show (build x :: Int)
| t == wordPrimTyCon = text $ show (build x :: Word)
| t == floatPrimTyCon = text $ show (build x :: Float)

10
_constraints
View File

@ -7,14 +7,4 @@
<size unit="G">4</size>
</physicalmemory>
</hardware>
<overwrite>
<conditions>
<arch>ppc64le</arch>
</conditions>
<hardware>
<memory>
<size unit="G">8</size>
</memory>
</hardware>
</overwrite>
</constraints>

10
buildpath-abi-stability.patch
View File

@ -1,8 +1,8 @@
Index: ghc-8.2.1/compiler/iface/MkIface.hs
Index: ghc-8.4.0.20171214/compiler/iface/MkIface.hs
===================================================================
--- ghc-8.2.1.orig/compiler/iface/MkIface.hs
+++ ghc-8.2.1/compiler/iface/MkIface.hs
@@ -681,7 +681,7 @@ addFingerprints hsc_env mb_old_fingerpri
--- ghc-8.4.0.20171214.orig/compiler/iface/MkIface.hs
+++ ghc-8.4.0.20171214/compiler/iface/MkIface.hs
@@ -689,7 +689,7 @@ addFingerprints hsc_env mb_old_fingerpri
iface_hash <- computeFingerprint putNameLiterally
(mod_hash,
ann_fn (mkVarOcc "module"), -- See mkIfaceAnnCache
@ -11,7 +11,7 @@ Index: ghc-8.2.1/compiler/iface/MkIface.hs
sorted_deps,
mi_hpc iface0)
@@ -714,6 +714,9 @@ addFingerprints hsc_env mb_old_fingerpri
@@ -724,6 +724,9 @@ addFingerprints hsc_env mb_old_fingerpri
(non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
fix_fn = mi_fix_fn iface0
ann_fn = mkIfaceAnnCache (mi_anns iface0)

8
ghc-8.0.2-Cabal-dynlibdir.patch
View File

@ -1,8 +1,8 @@
Index: ghc-8.2.0.20170507/libraries/Cabal/Cabal/Distribution/Simple/InstallDirs.hs
Index: ghc-8.4.0.20180204/libraries/Cabal/Cabal/Distribution/Simple/InstallDirs.hs
===================================================================
--- ghc-8.2.0.20170507.orig/libraries/Cabal/Cabal/Distribution/Simple/InstallDirs.hs
+++ ghc-8.2.0.20170507/libraries/Cabal/Cabal/Distribution/Simple/InstallDirs.hs
@@ -203,7 +203,7 @@ defaultInstallDirs' False comp userInsta
--- ghc-8.4.0.20180204.orig/libraries/Cabal/Cabal/Distribution/Simple/InstallDirs.hs
+++ ghc-8.4.0.20180204/libraries/Cabal/Cabal/Distribution/Simple/InstallDirs.hs
@@ -205,7 +205,7 @@ defaultInstallDirs' False comp userInsta
JHC -> "$compiler"
LHC -> "$compiler"
UHC -> "$pkgid"

3
ghc-8.2.2-src.tar.xz
View File

@ -1,3 +0,0 @@
version https://git-lfs.github.com/spec/v1
oid sha256:bb8ec3634aa132d09faa270bbd604b82dfa61f04855655af6f9d14a9eedc05fc
size 10753272

3
ghc-8.4.2-src.tar.xz Normal file
View File

@ -0,0 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:01cc32f24a06bf3b2428351b6d7fec791e82d042426d29ad9e5a245b35f0047b
size 11313140

8
ghc-pie.patch
View File

@ -1,8 +1,8 @@
Index: ghc-8.2.2/compiler/main/DynFlags.hs
Index: ghc-8.4.0.20180204/compiler/main/DynFlags.hs
===================================================================
--- ghc-8.2.2.orig/compiler/main/DynFlags.hs
+++ ghc-8.2.2/compiler/main/DynFlags.hs
@@ -4020,6 +4020,7 @@ default_PIC :: Platform -> [GeneralFlag]
--- ghc-8.4.0.20180204.orig/compiler/main/DynFlags.hs
+++ ghc-8.4.0.20180204/compiler/main/DynFlags.hs
@@ -4155,6 +4155,7 @@ default_PIC :: Platform -> [GeneralFlag]
default_PIC platform =
case (platformOS platform, platformArch platform) of
(OSDarwin, ArchX86_64) -> [Opt_PIC]

13
ghc.changes
View File

@ -1,3 +1,16 @@
-------------------------------------------------------------------
Thu Apr 26 19:51:11 UTC 2018 - ptrommler@icloud.com
- update to 8.4.2
- drop 0001-PPC-CodeGen-fix-lwa-instruction-generation.patch
* fixed upstream
- drop 0001-PPC-Implement-Atomic-operations.patch
* fixed upstream
- drop 0001-Use-__atomic-intrinsics-for-atomicread-write.patch
* fixed upstream
- drop D4089.patch
* fixed upstream
-------------------------------------------------------------------
Thu Apr 26 12:21:57 UTC 2018 - mimi.vx@gmail.com

81
ghc.spec
View File

@ -20,10 +20,16 @@
%define without_manual 1
%endif
%ifnarch %{arm} s390x
%define with_libnuma 1
%else
%define with_libnuma 0
%endif
%global unregisterised_archs s390 s390x
Name: ghc
Version: 8.2.2
Version: 8.4.2
Release: 0
Url: http://haskell.org/ghc/dist/%{version}/%{name}-%{version}-src.tar.xz
Summary: The Glorious Glasgow Haskell Compiler
@ -34,7 +40,7 @@ ExclusiveArch: aarch64 %{arm} %{ix86} x86_64 ppc64 ppc64le s390x
#!BuildIgnore: gcc-PIE
BuildRequires: binutils-devel
BuildRequires: gcc
BuildRequires: ghc-bootstrap >= 7.8
BuildRequires: ghc-bootstrap >= 8.0
BuildRequires: ghc-rpm-macros-extra
BuildRequires: glibc-devel
BuildRequires: gmp-devel
@ -46,33 +52,30 @@ BuildRequires: libffi48-devel
%else
BuildRequires: libffi-devel
%endif
BuildRequires: libtool
BuildRequires: ncurses-devel
BuildRequires: pkg-config
BuildRequires: xz
%ifarch aarch64 %{arm}
BuildRequires: binutils-gold
%endif
%ifarch aarch64 %{arm} %{ix86} x86_64
BuildRequires: llvm-devel
BuildRequires: llvm5-devel
%endif
BuildRequires: ncurses-devel
BuildRequires: pkg-config
BuildRequires: xz
%if %{undefined without_manual}
BuildRequires: python-sphinx
%endif
%if %with_libnuma
BuildRequires: libnuma-devel
%endif
PreReq: update-alternatives
Requires: ghc-compiler = %{version}-%{release}
Requires: ghc-ghc-devel = %{version}-%{release}
Requires: ghc-libraries = %{version}-%{release}
Source: http://haskell.org/ghc/dist/%{version}/%{name}-%{version}-src.tar.xz
Source1: ghc-rpmlintrc
# PATCH-FIX-UPSTREAM 0001-PPC-CodeGen-fix-lwa-instruction-generation.patch peter.trommler@ohm-hochschule.de -- Fix PPC codegen: Fixes ghc-zeromq4-haskell build on 64-bit PowerPCs
Patch30: 0001-PPC-CodeGen-fix-lwa-instruction-generation.patch
# PATCH-FIX-UPSTREAM 0001-PPC-Implement-Atomic-operations.patch ptrommler@icloud.com -- Inline atomic operations for PowerPC.
Patch32: 0001-PPC-Implement-Atomic-operations.patch
# PATCH-FIX-UPSTREAM 0001-Use-__atomic-intrinsics-for-atomicread-write.patch ptrommler@icloud.com -- Fix atomic read and atomic write on platforms that have no native code generator nor LLVM backend. This is s390x for openSUSE. See Haskell Trac #14244.
Patch33: 0001-Use-__atomic-intrinsics-for-atomicread-write.patch
# PATCH-FIX-UPSTREAM D4089.patch ptrommler@icloud.com -- Fix GHCi on ppc64. See Haskell Trac #11262
Patch34: D4089.patch
# PATCH-FIX-UPSTREAM ghc-pie.patch - set linux as default PIE platform
Patch35: ghc-pie.patch
# PATCH-FIX-OPENSUSE ghc-8.0.2-Cabal-dynlibdir.patch -- Fix shared library directory location.
@ -128,32 +131,39 @@ To install all of GHC install package ghc.
%global ghc_pkg_c_deps ghc-compiler = %{ghc_version_override}-%{release}
%if %with_libnuma
%define libnuma_dep ,libnuma-devel
%endif
%if %{defined ghclibdir}
%ghc_lib_subpackage -d Cabal-2.0.1.0
%ghc_lib_subpackage -d Cabal-2.2.0.1
%ghc_lib_subpackage -d array-0.5.2.0
%ghc_lib_subpackage -d -c gmp-devel,libffi-devel,libdw-devel,libelf-devel base-4.10.1.0
%ghc_lib_subpackage -d -c gmp-devel,libffi-devel,libdw-devel,libelf-devel%{libnuma_dep} base-4.11.1.0
%ghc_lib_subpackage -d binary-0.8.5.1
%ghc_lib_subpackage -d bytestring-0.10.8.2
%ghc_lib_subpackage -d containers-0.5.10.2
%ghc_lib_subpackage -d containers-0.5.11.0
%ghc_lib_subpackage -d deepseq-1.4.3.0
%ghc_lib_subpackage -d directory-1.3.0.2
%ghc_lib_subpackage -d filepath-1.4.1.2
%ghc_lib_subpackage -d directory-1.3.1.5
%ghc_lib_subpackage -d filepath-1.4.2
%ghc_lib_subpackage -d -x ghc-%{ghc_version_override}
%ghc_lib_subpackage -d ghc-boot-%{ghc_version_override}
%ghc_lib_subpackage -d ghc-boot-th-%{ghc_version_override}
%ghc_lib_subpackage -d ghc-compact-0.1.0.0
%ghc_lib_subpackage -d -x ghci-%{ghc_version_override}
%ghc_lib_subpackage -d haskeline-0.7.4.0
%ghc_lib_subpackage -d hoopl-3.10.2.2
%ghc_lib_subpackage -d haskeline-0.7.4.2
%ghc_lib_subpackage -d hpc-0.6.0.3
%ghc_lib_subpackage -d pretty-1.1.3.3
%ghc_lib_subpackage -d process-1.6.1.0
%ghc_lib_subpackage -d template-haskell-2.12.0.0
%ghc_lib_subpackage -d -c ncurses-devel terminfo-0.4.1.0
%ghc_lib_subpackage -d mtl-2.2.2
%ghc_lib_subpackage -d parsec-3.1.13.0
%ghc_lib_subpackage -d pretty-1.1.3.6
%ghc_lib_subpackage -d process-1.6.3.0
%ghc_lib_subpackage -d stm-2.4.5.0
%ghc_lib_subpackage -d template-haskell-2.13.0.0
%ghc_lib_subpackage -d -c ncurses-devel terminfo-0.4.1.1
%ghc_lib_subpackage -d text-1.2.3.0
%ghc_lib_subpackage -d time-1.8.0.2
%ghc_lib_subpackage -d transformers-0.5.2.0
%ghc_lib_subpackage -d transformers-0.5.5.0
%ghc_lib_subpackage -d unix-2.7.2.2
%ghc_lib_subpackage -d xhtml-3000.2.2
%ghc_lib_subpackage -d xhtml-3000.2.2.1
%endif
%global version %{ghc_version_override}
@ -174,14 +184,11 @@ except the ghc library, which is installed by the toplevel ghc metapackage.
%prep
%setup -q
%patch30 -p1
%patch32 -p1
%patch33 -p1
%patch34 -p1
%patch35 -p1
%patch100 -p1
%patch110 -p1
%patch111 -p1
#%%patch111 -p1
# Probably fixed upstream
%build
# Check if bootstrap is required, i.e. version is different from ghc's version
@ -281,6 +288,9 @@ make -j 2
%endif
%install
%if 0%{?suse_version} <= 1320
%ghc_suse_disable_debug_packages
%endif
%makeinstall
for i in %{ghc_packages_list}; do
@ -295,8 +305,8 @@ echo "%dir %{ghclibdir}" >> ghc-base.files
%ghc_gen_filelists ghc %{ghc_version_override}
%ghc_gen_filelists ghci %{ghc_version_override}
%ghc_gen_filelists ghc-prim 0.5.1.1
%ghc_gen_filelists integer-gmp 1.0.1.0
%ghc_gen_filelists ghc-prim 0.5.2.0
%ghc_gen_filelists integer-gmp 1.0.2.0
%define merge_filelist()\
cat ghc-%1.files >> ghc-%2.files\
@ -432,6 +442,7 @@ fi
%{_bindir}/haddock-ghc-%{version}
%{ghclibdir}/html
%{ghclibdir}/latex
%{ghclibdir}/llvm-targets
%{ghclibdir}/bin/haddock
%if %{undefined without_manual}
%{ghcdocbasedir}/haddock
@ -440,10 +451,12 @@ fi
%{ghcdocbasedir}/libraries/gen_contents_index
%{ghcdocbasedir}/libraries/hslogo-16.png
%{ghcdocbasedir}/libraries/ocean.css
%{ghcdocbasedir}/libraries/quick-jump.css
%{ghcdocbasedir}/libraries/prologue.txt
%{ghcdocbasedir}/libraries/synopsis.png
%{ghcdocbasedir}/index.html
%ghost %{ghcdocbasedir}/libraries/doc-index*.html
%ghost %{ghcdocbasedir}/libraries/haddock-bundle.min.js
%ghost %{ghcdocbasedir}/libraries/haddock-util.js
%ghost %{ghcdocbasedir}/libraries/index*.html
%ghost %{ghcdocbasedir}/libraries/minus.gif