From 71ec5bb07ccd1c13a3a5ec4faf1a423faf3afd6a24eb04087030052e0dcaf34a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20S=C3=BAkup?= Date: Thu, 20 Aug 2015 05:53:26 +0000 Subject: [PATCH] Accepting request 322625 from devel:languages:haskell:lts - update to 7.10.2 * type checker fixes * fixes for Aarch64 support * fix deadlock in runtime system when scheduling garbage collection - 7.10.1 highlights * implement Applicative Monad Proposal * implement Burning Bridges Proposal * support for partial type signatures * reimplement integer-gmp * support plugins in type checker (experimental!) - drop llvm-powerpc64-datalayout.patch * this patch was incomplete all along and now we have our native code generator - drop ghc-cabal-unversion-docdir.patch * ghc-rpm-macros is following ghc's doc layout so no need to patch - drop D349.patch * fixed upstream - drop integer-gmp.patch * we do not support SLE11 anymore - drop ghc-7.8.2-cgen-constify.patch * fixed upstream - drop D560.patch * fixed upstream - drop ghc-glibc-2.20_BSD_SOURCE.patch * fixed upstream - drop ghc-arm64.patch * fixed upstream - drop ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch * fixed upstream - refresh 0001-implement-native-code-generator-for-ppc64.patch OBS-URL: https://build.opensuse.org/request/show/322625 OBS-URL: https://build.opensuse.org/package/show/devel:languages:haskell/ghc?expand=0&rev=183 --- ...ment-native-code-generator-for-ppc64.patch | 514 +++++++++--------- D349.patch | 293 ---------- D560.patch | 320 ----------- _service | 3 - ghc-7.10.2-src.tar.xz | 3 + ghc-7.8.2-cgen-constify.patch | 34 -- ghc-7.8.4-src.tar.xz | 3 - ghc-arm64.patch | 322 ----------- ...ble-SMP-and-GHCi-support-for-Aarch64.patch | 31 -- ghc-glibc-2.20_BSD_SOURCE.patch | 26 - ghc.changes | 36 ++ ghc.spec | 91 +--- integer-gmp.patch | 26 - llvm-powerpc64-datalayout.patch | 14 - 14 files changed, 332 insertions(+), 1384 deletions(-) delete mode 100644 D349.patch delete mode 100644 D560.patch delete mode 100644 _service create mode 100644 ghc-7.10.2-src.tar.xz delete mode 100644 ghc-7.8.2-cgen-constify.patch delete mode 100644 ghc-7.8.4-src.tar.xz delete mode 100644 ghc-arm64.patch delete mode 100644 ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch delete mode 100644 ghc-glibc-2.20_BSD_SOURCE.patch delete mode 100644 integer-gmp.patch delete mode 100644 llvm-powerpc64-datalayout.patch diff --git a/0001-implement-native-code-generator-for-ppc64.patch b/0001-implement-native-code-generator-for-ppc64.patch index a873855..2e74d94 100644 --- a/0001-implement-native-code-generator-for-ppc64.patch +++ b/0001-implement-native-code-generator-for-ppc64.patch @@ -1,7 +1,7 @@ -Index: ghc-7.8.4/aclocal.m4 +Index: ghc-7.10.1.20150630/aclocal.m4 =================================================================== ---- ghc-7.8.4.orig/aclocal.m4 -+++ ghc-7.8.4/aclocal.m4 +--- ghc-7.10.1.20150630.orig/aclocal.m4 ++++ ghc-7.10.1.20150630/aclocal.m4 @@ -188,7 +188,10 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_V test -z "[$]2" || eval "[$]2=ArchPPC" ;; @@ -14,7 +14,7 @@ Index: ghc-7.8.4/aclocal.m4 ;; sparc) test -z "[$]2" || eval "[$]2=ArchSPARC" -@@ -206,7 +209,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_V +@@ -209,7 +212,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_V mipsel) test -z "[$]2" || eval "[$]2=ArchMipsel" ;; @@ -23,11 +23,11 @@ Index: ghc-7.8.4/aclocal.m4 test -z "[$]2" || eval "[$]2=ArchUnknown" ;; *) -Index: ghc-7.8.4/compiler/cmm/CLabel.hs +Index: ghc-7.10.1.20150630/compiler/cmm/CLabel.hs =================================================================== ---- ghc-7.8.4.orig/compiler/cmm/CLabel.hs -+++ ghc-7.8.4/compiler/cmm/CLabel.hs -@@ -1158,16 +1158,24 @@ pprDynamicLinkerAsmLabel platform dllInf +--- ghc-7.10.1.20150630.orig/compiler/cmm/CLabel.hs ++++ ghc-7.10.1.20150630/compiler/cmm/CLabel.hs +@@ -1186,16 +1186,24 @@ pprDynamicLinkerAsmLabel platform dllInf else if osElfTarget (platformOS platform) then if platformArch platform == ArchPPC then case dllInfo of @@ -56,59 +56,94 @@ Index: ghc-7.8.4/compiler/cmm/CLabel.hs else case dllInfo of CodeStub -> ppr lbl <> text "@plt" SymbolPtr -> text ".LC_" <> ppr lbl -Index: ghc-7.8.4/compiler/codeGen/CodeGen/Platform.hs +Index: ghc-7.10.1.20150630/compiler/codeGen/CodeGen/Platform.hs =================================================================== ---- ghc-7.8.4.orig/compiler/codeGen/CodeGen/Platform.hs -+++ ghc-7.8.4/compiler/codeGen/CodeGen/Platform.hs -@@ -29,7 +29,7 @@ callerSaves platform - ArchSPARC -> SPARC.callerSaves +--- ghc-7.10.1.20150630.orig/compiler/codeGen/CodeGen/Platform.hs ++++ ghc-7.10.1.20150630/compiler/codeGen/CodeGen/Platform.hs +@@ -31,7 +31,7 @@ callerSaves platform ArchARM {} -> ARM.callerSaves + ArchARM64 -> ARM64.callerSaves arch - | arch `elem` [ArchPPC, ArchPPC_64] -> + | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> case platformOS platform of OSDarwin -> PPC_Darwin.callerSaves _ -> PPC.callerSaves -@@ -51,7 +51,7 @@ activeStgRegs platform - ArchSPARC -> SPARC.activeStgRegs +@@ -54,7 +54,7 @@ activeStgRegs platform ArchARM {} -> ARM.activeStgRegs + ArchARM64 -> ARM64.activeStgRegs arch - | arch `elem` [ArchPPC, ArchPPC_64] -> + | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> case platformOS platform of OSDarwin -> PPC_Darwin.activeStgRegs _ -> PPC.activeStgRegs -@@ -68,7 +68,7 @@ haveRegBase platform - ArchSPARC -> SPARC.haveRegBase +@@ -72,7 +72,7 @@ haveRegBase platform ArchARM {} -> ARM.haveRegBase + ArchARM64 -> ARM64.haveRegBase arch - | arch `elem` [ArchPPC, ArchPPC_64] -> + | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> case platformOS platform of OSDarwin -> PPC_Darwin.haveRegBase _ -> PPC.haveRegBase -@@ -85,7 +85,7 @@ globalRegMaybe platform - ArchSPARC -> SPARC.globalRegMaybe +@@ -90,7 +90,7 @@ globalRegMaybe platform ArchARM {} -> ARM.globalRegMaybe + ArchARM64 -> ARM64.globalRegMaybe arch - | arch `elem` [ArchPPC, ArchPPC_64] -> + | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> case platformOS platform of OSDarwin -> PPC_Darwin.globalRegMaybe _ -> PPC.globalRegMaybe -@@ -102,7 +102,7 @@ freeReg platform - ArchSPARC -> SPARC.freeReg +@@ -108,7 +108,7 @@ freeReg platform ArchARM {} -> ARM.freeReg + ArchARM64 -> ARM64.freeReg arch - | arch `elem` [ArchPPC, ArchPPC_64] -> + | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> case platformOS platform of OSDarwin -> PPC_Darwin.freeReg _ -> PPC.freeReg -Index: ghc-7.8.4/compiler/nativeGen/PIC.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/AsmCodeGen.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/PIC.hs -+++ ghc-7.8.4/compiler/nativeGen/PIC.hs +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/AsmCodeGen.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/AsmCodeGen.hs +@@ -166,18 +166,18 @@ nativeCodeGen dflags this_mod modLoc h u + => NcgImpl statics instr jumpDest -> IO UniqSupply + nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms + in case platformArch platform of +- ArchX86 -> nCG' (x86NcgImpl dflags) +- ArchX86_64 -> nCG' (x86_64NcgImpl dflags) +- ArchPPC -> nCG' (ppcNcgImpl dflags) +- ArchSPARC -> nCG' (sparcNcgImpl dflags) +- ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" +- ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64" +- ArchPPC_64 -> panic "nativeCodeGen: No NCG for PPC 64" +- ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" +- ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" +- ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" +- ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" +- ArchJavaScript -> panic "nativeCodeGen: No NCG for JavaScript" ++ ArchX86 -> nCG' (x86NcgImpl dflags) ++ ArchX86_64 -> nCG' (x86_64NcgImpl dflags) ++ ArchPPC -> nCG' (ppcNcgImpl dflags) ++ ArchSPARC -> nCG' (sparcNcgImpl dflags) ++ ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" ++ ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64" ++ ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags) ++ ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" ++ ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" ++ ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" ++ ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ++ ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" + + x86NcgImpl :: DynFlags -> NcgImpl (Alignment, CmmStatics) X86.Instr.Instr X86.Instr.JumpDest + x86NcgImpl dflags +Index: ghc-7.10.1.20150630/compiler/nativeGen/PIC.hs +=================================================================== +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/PIC.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/PIC.hs @@ -158,7 +158,14 @@ cmmMakePicReference dflags lbl -- everything gets relocated at runtime | OSMinGW32 <- platformOS $ targetPlatform dflags @@ -246,10 +281,10 @@ Index: ghc-7.8.4/compiler/nativeGen/PIC.hs initializePicBase_ppc _ _ _ _ = panic "initializePicBase_ppc: not needed" -Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/PPC/CodeGen.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/PPC/CodeGen.hs -+++ ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/PPC/CodeGen.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/PPC/CodeGen.hs @@ -77,14 +77,24 @@ cmmTopCodeGen cmmTopCodeGen (CmmProc info lab live graph) = do let blocks = toBlockListEntryFirst graph @@ -279,7 +314,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs cmmTopCodeGen (CmmData sec dat) = do return [CmmData sec dat] -- no translation, we just use CmmStatic -@@ -194,26 +204,6 @@ getRegisterReg platform (CmmGlobal mid) +@@ -197,26 +207,6 @@ getRegisterReg platform (CmmGlobal mid) -- ones which map to a real machine register on this -- platform. Hence ... @@ -306,7 +341,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs -- | Convert a BlockId to some CmmStatic data jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags)) -@@ -261,7 +251,7 @@ data ChildCode64 -- a.k.a "Regist +@@ -264,7 +254,7 @@ data ChildCode64 -- a.k.a "Regist -- Reg may be modified @@ -315,7 +350,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs -- we don't mind which one it is. getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock) getSomeReg expr = do -@@ -275,7 +265,7 @@ getSomeReg expr = do +@@ -278,7 +268,7 @@ getSomeReg expr = do getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock) getI64Amodes addrTree = do @@ -324,7 +359,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs case addrOffset hi_addr 4 of Just lo_addr -> return (hi_addr, lo_addr, addr_code) Nothing -> do (hi_ptr, code) <- getSomeReg addrTree -@@ -386,10 +376,12 @@ getRegister e = do dflags <- getDynFlags +@@ -389,10 +379,12 @@ getRegister e = do dflags <- getDynFlags getRegister' :: DynFlags -> CmmExpr -> NatM Register @@ -341,7 +376,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs getRegister' dflags (CmmReg reg) = return (Fixed (cmmTypeSize (cmmRegType dflags reg)) -@@ -424,30 +416,54 @@ getRegister' dflags (CmmMachOp (MO_SS_Co +@@ -427,30 +419,54 @@ getRegister' dflags (CmmMachOp (MO_SS_Co return $ Fixed II32 rlo code getRegister' dflags (CmmLoad mem pk) @@ -402,7 +437,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps = case mop of MO_Not rep -> triv_ucode_int rep NOT -@@ -465,7 +481,16 @@ getRegister' dflags (CmmMachOp mop [x]) +@@ -468,7 +484,16 @@ getRegister' dflags (CmmMachOp mop [x]) | from == to -> conversionNop (intSize to) x -- narrowing is a nop: we treat the high bits as undefined @@ -420,7 +455,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs MO_SS_Conv W16 W8 -> conversionNop II8 x MO_SS_Conv W8 to -> triv_ucode_int to (EXTS II8) MO_SS_Conv W16 to -> triv_ucode_int to (EXTS II16) -@@ -473,7 +498,17 @@ getRegister' dflags (CmmMachOp mop [x]) +@@ -476,7 +501,17 @@ getRegister' dflags (CmmMachOp mop [x]) MO_UU_Conv from to | from == to -> conversionNop (intSize to) x -- narrowing is a nop: we treat the high bits as undefined @@ -439,7 +474,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs MO_UU_Conv W16 W8 -> conversionNop II8 x MO_UU_Conv W8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 W32)) MO_UU_Conv W16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 W32)) -@@ -486,8 +521,9 @@ getRegister' dflags (CmmMachOp mop [x]) +@@ -489,8 +524,9 @@ getRegister' dflags (CmmMachOp mop [x]) conversionNop new_size expr = do e_code <- getRegister' dflags expr return (swizzleRegisterRep e_code new_size) @@ -450,7 +485,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs = case mop of MO_F_Eq _ -> condFltReg EQQ x y MO_F_Ne _ -> condFltReg NE x y -@@ -496,18 +532,28 @@ getRegister' _ (CmmMachOp mop [x, y]) -- +@@ -499,18 +535,28 @@ getRegister' _ (CmmMachOp mop [x, y]) -- MO_F_Lt _ -> condFltReg LTT x y MO_F_Le _ -> condFltReg LE x y @@ -491,7 +526,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs MO_F_Add w -> triv_float w FADD MO_F_Sub w -> triv_float w FSUB -@@ -538,32 +584,53 @@ getRegister' _ (CmmMachOp mop [x, y]) -- +@@ -541,32 +587,53 @@ getRegister' _ (CmmMachOp mop [x, y]) -- -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep) _ -> trivialCodeNoImm' (intSize rep) SUBF y x @@ -555,7 +590,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs getRegister' _ (CmmLit (CmmInt i rep)) | Just imm <- makeImmediate rep True i = let -@@ -575,7 +642,7 @@ getRegister' _ (CmmLit (CmmFloat f frep) +@@ -578,7 +645,7 @@ getRegister' _ (CmmLit (CmmFloat f frep) lbl <- getNewLabelNat dflags <- getDynFlags dynRef <- cmmMakeDynamicReference dflags DataReference lbl @@ -564,7 +599,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs let size = floatSize frep code dst = LDATA ReadOnlyData (Statics lbl -@@ -584,6 +651,7 @@ getRegister' _ (CmmLit (CmmFloat f frep) +@@ -587,6 +654,7 @@ getRegister' _ (CmmLit (CmmFloat f frep) return (Any size code) getRegister' dflags (CmmLit lit) @@ -572,7 +607,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs = let rep = cmmLitType dflags lit imm = litToImm lit code dst = toOL [ -@@ -591,18 +659,46 @@ getRegister' dflags (CmmLit lit) +@@ -594,18 +662,46 @@ getRegister' dflags (CmmLit lit) ADD dst dst (RIImm (LO imm)) ] in return (Any (cmmTypeSize rep) code) @@ -627,7 +662,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. -@@ -628,26 +724,68 @@ temporary, then do the other computation +@@ -631,26 +727,68 @@ temporary, then do the other computation ... (tmp) ... -} @@ -702,7 +737,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs = do tmp <- getNewRegNat II32 (src, srcCode) <- getSomeReg x -@@ -655,20 +793,40 @@ getAmode (CmmMachOp (MO_Add W32) [x, Cmm +@@ -658,20 +796,40 @@ getAmode (CmmMachOp (MO_Add W32) [x, Cmm code = srcCode `snocOL` ADDIS tmp src (HA imm) return (Amode (AddrRegImm tmp (LO imm)) code) @@ -750,7 +785,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs = do (reg, code) <- getSomeReg other let -@@ -676,7 +834,6 @@ getAmode other +@@ -679,7 +837,6 @@ getAmode other return (Amode (AddrRegImm reg off) code) @@ -758,7 +793,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs -- The 'CondCode' type: Condition codes passed up the tree. data CondCode = CondCode Bool Cond InstrBlock -@@ -686,10 +843,12 @@ data CondCode +@@ -689,10 +846,12 @@ data CondCode getCondCode :: CmmExpr -> NatM CondCode -- almost the same as everywhere else - but we need to @@ -773,7 +808,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs MO_F_Eq W32 -> condFltCode EQQ x y MO_F_Ne W32 -> condFltCode NE x y MO_F_Gt W32 -> condFltCode GTT x y -@@ -704,18 +863,28 @@ getCondCode (CmmMachOp mop [x, y]) +@@ -707,18 +866,28 @@ getCondCode (CmmMachOp mop [x, y]) MO_F_Lt W64 -> condFltCode LTT x y MO_F_Le W64 -> condFltCode LE x y @@ -814,7 +849,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs _ -> pprPanic "getCondCode(powerpc)" (pprMachOp mop) -@@ -729,21 +898,24 @@ getCondCode _ = panic "getCondCode(2)(po +@@ -732,21 +901,24 @@ getCondCode _ = panic "getCondCode(2)(po condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode -- ###FIXME: I16 and I8! @@ -843,7 +878,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs return (CondCode False cond code') condFltCode cond x y = do -@@ -781,7 +953,9 @@ assignReg_FltCode :: Size -> CmmReg -> +@@ -784,7 +956,9 @@ assignReg_FltCode :: Size -> CmmReg -> assignMem_IntCode pk addr src = do (srcReg, code) <- getSomeReg src @@ -854,7 +889,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr -- dst is a reg, but src could be anything -@@ -809,9 +983,42 @@ genJump (CmmLit (CmmLabel lbl)) +@@ -812,9 +986,42 @@ genJump (CmmLit (CmmLabel lbl)) genJump tree = do @@ -898,7 +933,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs -- ----------------------------------------------------------------------------- -- Unconditional branches -@@ -867,11 +1074,18 @@ genCCall target dest_regs argsAndHints +@@ -861,11 +1068,18 @@ genCCall target dest_regs argsAndHints = do dflags <- getDynFlags let platform = targetPlatform dflags case platformOS platform of @@ -921,7 +956,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs genCCall' :: DynFlags -@@ -910,7 +1124,11 @@ genCCall' +@@ -904,7 +1118,11 @@ genCCall' * The SysV spec claims that FF32 is represented as FF64 on the stack. GCC on PowerPC Linux does not agree, so neither do we. @@ -934,7 +969,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs caller's stack frame, allocated in the caller's prologue code (large enough to hold the parameter lists for all called routines). The NCG already uses the stack for register spilling, leaving 64 bytes free at the top. -@@ -949,39 +1167,66 @@ genCCall' dflags gcp target dest_regs ar +@@ -943,39 +1161,66 @@ genCCall' dflags gcp target dest_regs ar PrimTarget mop -> outOfLineMachOp mop let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode @@ -1013,7 +1048,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs -- need to remove alignment information args | PrimTarget mop <- target, -@@ -998,14 +1243,34 @@ genCCall' dflags gcp target dest_regs ar +@@ -992,14 +1237,34 @@ genCCall' dflags gcp target dest_regs ar roundTo a x | x `mod` a == 0 = x | otherwise = x + a - (x `mod` a) @@ -1050,7 +1085,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs toOL [ADD sp sp (RIImm (ImmInt delta)), DELTA 0] | otherwise = nilOL -@@ -1014,7 +1279,8 @@ genCCall' dflags gcp target dest_regs ar +@@ -1008,7 +1273,8 @@ genCCall' dflags gcp target dest_regs ar passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed) passArguments ((arg,arg_ty):args) gprs fprs stackOffset @@ -1060,7 +1095,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs do ChildCode64 code vr_lo <- iselExpr64 arg let vr_hi = getHiVRegFromLo vr_lo -@@ -1052,6 +1318,7 @@ genCCall' dflags gcp target dest_regs ar +@@ -1046,6 +1312,7 @@ genCCall' dflags gcp target dest_regs ar _ -> -- only one or no regs left passArguments args [] fprs (stackOffset'+8) stackCode accumUsed @@ -1068,7 +1103,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed | reg : _ <- regs = do -@@ -1063,8 +1330,10 @@ genCCall' dflags gcp target dest_regs ar +@@ -1057,8 +1324,10 @@ genCCall' dflags gcp target dest_regs ar -- The Darwin ABI requires that we reserve -- stack slots for register parameters GCPDarwin -> stackOffset + stackBytes @@ -1080,7 +1115,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs passArguments args (drop nGprs gprs) (drop nFprs fprs) -@@ -1092,6 +1361,11 @@ genCCall' dflags gcp target dest_regs ar +@@ -1086,6 +1355,11 @@ genCCall' dflags gcp target dest_regs ar roundTo 8 stackOffset | otherwise -> stackOffset @@ -1092,7 +1127,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs stackSlot = AddrRegImm sp (ImmInt stackOffset') (nGprs, nFprs, stackBytes, regs) = case gcp of -@@ -1117,6 +1391,18 @@ genCCall' dflags gcp target dest_regs ar +@@ -1111,6 +1385,18 @@ genCCall' dflags gcp target dest_regs ar FF64 -> (0, 1, 8, fprs) II64 -> panic "genCCall' passArguments II64" FF80 -> panic "genCCall' passArguments FF80" @@ -1111,7 +1146,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs moveResult reduceToFF32 = case dest_regs of -@@ -1124,8 +1410,9 @@ genCCall' dflags gcp target dest_regs ar +@@ -1118,8 +1404,9 @@ genCCall' dflags gcp target dest_regs ar [dest] | reduceToFF32 && isFloat32 rep -> unitOL (FRSP r_dest f1) | isFloat32 rep || isFloat64 rep -> unitOL (MR r_dest f1) @@ -1123,7 +1158,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs | otherwise -> unitOL (MR r_dest r3) where rep = cmmRegType dflags (CmmLocal dest) r_dest = getRegisterReg platform (CmmLocal dest) -@@ -1201,17 +1488,19 @@ genCCall' dflags gcp target dest_regs ar +@@ -1203,17 +1490,19 @@ genCCall' dflags gcp target dest_regs ar genSwitch :: DynFlags -> CmmExpr -> [Maybe BlockId] -> NatM InstrBlock genSwitch dflags expr ids @@ -1147,7 +1182,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs ADD tmp tmp (RIReg tableReg), MTCTR tmp, BCTR ids (Just lbl) -@@ -1220,12 +1509,14 @@ genSwitch dflags expr ids +@@ -1222,12 +1511,14 @@ genSwitch dflags expr ids | otherwise = do (reg,e_code) <- getSomeReg expr @@ -1165,7 +1200,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs MTCTR tmp, BCTR ids (Just lbl) ] -@@ -1235,7 +1526,9 @@ generateJumpTableForInstr :: DynFlags -> +@@ -1237,7 +1528,9 @@ generateJumpTableForInstr :: DynFlags -> -> Maybe (NatCmmDecl CmmStatics Instr) generateJumpTableForInstr dflags (BCTR ids (Just lbl)) = let jumpTable @@ -1176,7 +1211,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs | otherwise = map (jumpTableEntry dflags) ids where jumpTableEntryRel Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags)) -@@ -1250,25 +1543,14 @@ generateJumpTableForInstr _ _ = Nothing +@@ -1252,25 +1545,14 @@ generateJumpTableForInstr _ _ = Nothing -- Turn those condition codes into integers now (when they appear on -- the right hand side of an assignment). @@ -1203,7 +1238,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs code dst = cond_code `appOL` negate_code `appOL` toOL [ -@@ -1294,7 +1576,8 @@ condReg getCond = do +@@ -1296,7 +1578,8 @@ condReg getCond = do GU -> (1, False) _ -> panic "PPC.CodeGen.codeReg: no match" @@ -1213,7 +1248,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs condIntReg cond x y = condReg (condIntCode cond x y) condFltReg cond x y = condReg (condFltCode cond x y) -@@ -1363,6 +1646,27 @@ trivialCode rep _ instr x y = do +@@ -1365,6 +1648,27 @@ trivialCode rep _ instr x y = do let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2) return (Any (intSize rep) code) @@ -1241,7 +1276,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs trivialCodeNoImm' :: Size -> (Reg -> Reg -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register trivialCodeNoImm' size instr x y = do -@@ -1393,25 +1697,33 @@ trivialUCode rep instr x = do +@@ -1395,25 +1699,33 @@ trivialUCode rep instr x = do remainderCode :: Width -> (Reg -> Reg -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register remainderCode rep div x y = do @@ -1278,7 +1313,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs let code' dst = code `appOL` maybe_exts `appOL` toOL [ LDATA ReadOnlyData $ Statics lbl -@@ -1441,8 +1753,46 @@ coerceInt2FP fromRep toRep x = do +@@ -1443,8 +1755,46 @@ coerceInt2FP fromRep toRep x = do return (Any (floatSize toRep) code') @@ -1326,7 +1361,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs dflags <- getDynFlags -- the reps don't really matter: F*->FF64 and II32->I* are no-ops (src, code) <- getSomeReg x -@@ -1457,6 +1807,22 @@ coerceFP2Int _ toRep x = do +@@ -1459,6 +1809,22 @@ coerceFP2Int _ toRep x = do LD II32 dst (spRel dflags 3)] return (Any (intSize toRep) code') @@ -1349,11 +1384,11 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/CodeGen.hs -- Note [.LCTOC1 in PPC PIC code] -- The .LCTOC1 label is defined to point 32768 bytes into the GOT table -- to make the most of the PPC's 16-bit displacements. -Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/PPC/Instr.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/PPC/Instr.hs -+++ ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs -@@ -47,8 +47,10 @@ import Data.Maybe (fromMaybe) +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/PPC/Instr.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/PPC/Instr.hs +@@ -49,8 +49,10 @@ import Data.Maybe (fromMaybe) -------------------------------------------------------------------------------- -- Size of a PPC memory address, in bytes. -- @@ -1366,7 +1401,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs -- | Instruction instance for powerpc -@@ -72,16 +74,18 @@ instance Instruction Instr where +@@ -74,16 +76,18 @@ instance Instruction Instr where ppc_mkStackAllocInstr :: Platform -> Int -> Instr ppc_mkStackAllocInstr platform amount = case platformArch platform of @@ -1391,7 +1426,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs -- -- See note [extra spill slots] in X86/Instr.hs -@@ -208,9 +212,12 @@ data Instr +@@ -210,9 +214,12 @@ data Instr | SUBF Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1 | SUBFC Reg Reg Reg -- (carrying) dst, src1, src2 ; dst = src2 - src1 | SUBFE Reg Reg Reg -- (extend) dst, src1, src2 ; dst = src2 - src1 @@ -1404,7 +1439,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs | MULLW_MayOflo Reg Reg Reg -- dst = 1 if src1 * src2 overflows -@@ -218,9 +225,16 @@ data Instr +@@ -220,9 +227,16 @@ data Instr -- mullwo. dst, src1, src2 -- mfxer dst -- rlwinm dst, dst, 2, 31,31 @@ -1421,7 +1456,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs | XOR Reg Reg RI -- dst, src1, src2 | XORIS Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2 -@@ -229,9 +243,9 @@ data Instr +@@ -231,9 +245,9 @@ data Instr | NEG Reg Reg | NOT Reg Reg @@ -1434,7 +1469,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs | RLWINM Reg Reg Int Int Int -- Rotate Left Word Immediate then AND with Mask -@@ -244,6 +258,8 @@ data Instr +@@ -246,6 +260,8 @@ data Instr | FCMP Reg Reg | FCTIWZ Reg Reg -- convert to integer word @@ -1443,7 +1478,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs | FRSP Reg Reg -- reduce to single precision -- (but destination is a FP register) -@@ -253,9 +269,13 @@ data Instr +@@ -255,9 +271,13 @@ data Instr | MFLR Reg -- move from link register | FETCHPC Reg -- pseudo-instruction: -- bcl to next insn, mflr reg @@ -1459,7 +1494,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. -@@ -290,22 +310,28 @@ ppc_regUsageOfInstr platform instr +@@ -292,22 +312,28 @@ ppc_regUsageOfInstr platform instr SUBF reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) SUBFC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) SUBFE reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) @@ -1491,7 +1526,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs RLWINM reg1 reg2 _ _ _ -> usage ([reg2], [reg1]) FADD _ r1 r2 r3 -> usage ([r2,r3], [r1]) -@@ -315,10 +341,13 @@ ppc_regUsageOfInstr platform instr +@@ -317,10 +343,13 @@ ppc_regUsageOfInstr platform instr FNEG r1 r2 -> usage ([r2], [r1]) FCMP r1 r2 -> usage ([r1,r2], []) FCTIWZ r1 r2 -> usage ([r2], [r1]) @@ -1505,7 +1540,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs _ -> noUsage where usage (src, dst) = RU (filter (interesting platform) src) -@@ -367,21 +396,27 @@ ppc_patchRegsOfInstr instr env +@@ -369,21 +398,27 @@ ppc_patchRegsOfInstr instr env SUBF reg1 reg2 reg3 -> SUBF (env reg1) (env reg2) (env reg3) SUBFC reg1 reg2 reg3 -> SUBFC (env reg1) (env reg2) (env reg3) SUBFE reg1 reg2 reg3 -> SUBFE (env reg1) (env reg2) (env reg3) @@ -1536,7 +1571,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs RLWINM reg1 reg2 sh mb me -> RLWINM (env reg1) (env reg2) sh mb me FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3) -@@ -391,10 +426,13 @@ ppc_patchRegsOfInstr instr env +@@ -393,10 +428,13 @@ ppc_patchRegsOfInstr instr env FNEG r1 r2 -> FNEG (env r1) (env r2) FCMP r1 r2 -> FCMP (env r1) (env r2) FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2) @@ -1550,7 +1585,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs _ -> instr where fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) -@@ -457,11 +495,14 @@ ppc_mkSpillInstr +@@ -459,11 +497,14 @@ ppc_mkSpillInstr ppc_mkSpillInstr dflags reg delta slot = let platform = targetPlatform dflags off = spillSlotToOffset slot @@ -1567,7 +1602,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs in ST sz reg (AddrRegImm sp (ImmInt (off-delta))) -@@ -475,9 +516,12 @@ ppc_mkLoadInstr +@@ -477,9 +518,12 @@ ppc_mkLoadInstr ppc_mkLoadInstr dflags reg delta slot = let platform = targetPlatform dflags off = spillSlotToOffset slot @@ -1581,7 +1616,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs RcDouble -> FF64 _ -> panic "PPC.Instr.mkLoadInstr: no match" in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) -@@ -498,8 +542,8 @@ maxSpillSlots dflags +@@ -500,8 +544,8 @@ maxSpillSlots dflags -- = 0 -- useful for testing allocMoreStack -- | The number of bytes that the stack pointer should be aligned @@ -1592,10 +1627,10 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Instr.hs stackAlign :: Int stackAlign = 16 -Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/PPC/Ppr.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/PPC/Ppr.hs -+++ ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/PPC/Ppr.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/PPC/Ppr.hs @@ -39,11 +39,11 @@ import Unique ( pprUnique import Platform import FastString @@ -1628,7 +1663,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs vcat (map (pprBasicBlock top_info) blocks) Just (Statics info_lbl _) -> -@@ -86,6 +91,35 @@ pprNatCmmDecl proc@(CmmProc top_info lbl +@@ -81,6 +86,35 @@ pprNatCmmDecl proc@(CmmProc top_info lbl else empty) @@ -1664,7 +1699,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc pprBasicBlock info_env (BasicBlock blockid instrs) = maybe_infotable $$ -@@ -213,6 +247,7 @@ pprSize x +@@ -208,6 +242,7 @@ pprSize x II8 -> sLit "b" II16 -> sLit "h" II32 -> sLit "w" @@ -1672,7 +1707,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs FF32 -> sLit "fs" FF64 -> sLit "fd" _ -> panic "PPC.Ppr.pprSize: no match") -@@ -262,6 +297,18 @@ pprImm (HA i) +@@ -257,6 +292,18 @@ pprImm (HA i) then hcat [ text "ha16(", pprImm i, rparen ] else pprImm i <> text "@ha" @@ -1691,32 +1726,35 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs pprAddr :: AddrMode -> SDoc pprAddr (AddrRegReg r1 r2) -@@ -276,17 +323,23 @@ pprSectionHeader :: Section -> SDoc - pprSectionHeader seg - = sdocWithPlatform $ \platform -> - let osDarwin = platformOS platform == OSDarwin -+ ppc64 = not $ target32Bit platform - in case seg of - Text -> ptext (sLit ".text\n.align 2") -- Data -> ptext (sLit ".data\n.align 2") -+ Data -+ | ppc64 -> ptext (sLit ".data\n.align 3") -+ | otherwise -> ptext (sLit ".data\n.align 2") - ReadOnlyData - | osDarwin -> ptext (sLit ".const\n.align 2") -+ | ppc64 -> ptext (sLit ".section .rodata\n\t.align 3") - | otherwise -> ptext (sLit ".section .rodata\n\t.align 2") - RelocatableReadOnlyData - | osDarwin -> ptext (sLit ".const_data\n.align 2") -+ | ppc64 -> ptext (sLit ".data\n\t.align 3") - | otherwise -> ptext (sLit ".data\n\t.align 2") - UninitialisedData - | osDarwin -> ptext (sLit ".const_data\n.align 2") -+ | ppc64 -> ptext (sLit ".section .bss\n\t.align 3") - | otherwise -> ptext (sLit ".section .bss\n\t.align 2") - ReadOnlyData16 - | osDarwin -> ptext (sLit ".const\n.align 4") -@@ -298,32 +351,38 @@ pprSectionHeader seg +@@ -270,18 +317,25 @@ pprAddr (AddrRegImm r1 imm) = hcat [ ppr + pprSectionHeader :: Section -> SDoc + pprSectionHeader seg = + sdocWithPlatform $ \platform -> +- let osDarwin = platformOS platform == OSDarwin in ++ let osDarwin = platformOS platform == OSDarwin ++ ppc64 = not $ target32Bit platform ++ in + case seg of + Text -> text ".text\n\t.align 2" +- Data -> text ".data\n\t.align 2" ++ Data ++ | ppc64 -> text ".data\n.align 3" ++ | otherwise -> text ".data\n.align 2" + ReadOnlyData + | osDarwin -> text ".const\n\t.align 2" ++ | ppc64 -> text ".section .rodata\n\t.align 3" + | otherwise -> text ".section .rodata\n\t.align 2" + RelocatableReadOnlyData + | osDarwin -> text ".const_data\n\t.align 2" ++ | ppc64 -> text ".data\n\t.align 3" + | otherwise -> text ".data\n\t.align 2" + UninitialisedData + | osDarwin -> text ".const_data\n\t.align 2" ++ | ppc64 -> text ".section .bss\n\t.align 3" + | otherwise -> text ".section .bss\n\t.align 2" + ReadOnlyData16 + | osDarwin -> text ".const\n\t.align 4" +@@ -293,32 +347,38 @@ pprSectionHeader seg = pprDataItem :: CmmLit -> SDoc pprDataItem lit = sdocWithDynFlags $ \dflags -> @@ -1763,7 +1801,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs = panic "PPC.Ppr.pprDataItem: no match" -@@ -370,6 +429,7 @@ pprInstr (LD sz reg addr) = hcat [ +@@ -365,6 +425,7 @@ pprInstr (LD sz reg addr) = hcat [ II8 -> sLit "bz" II16 -> sLit "hz" II32 -> sLit "wz" @@ -1771,7 +1809,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs FF32 -> sLit "fs" FF64 -> sLit "fd" _ -> panic "PPC.Ppr.pprInstr: no match" -@@ -388,6 +448,7 @@ pprInstr (LA sz reg addr) = hcat [ +@@ -383,6 +444,7 @@ pprInstr (LA sz reg addr) = hcat [ II8 -> sLit "ba" II16 -> sLit "ha" II32 -> sLit "wa" @@ -1779,7 +1817,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs FF32 -> sLit "fs" FF64 -> sLit "fd" _ -> panic "PPC.Ppr.pprInstr: no match" -@@ -556,10 +617,14 @@ pprInstr (ADDE reg1 reg2 reg3) = pprLogi +@@ -551,10 +613,14 @@ pprInstr (ADDE reg1 reg2 reg3) = pprLogi pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3) pprInstr (SUBFC reg1 reg2 reg3) = pprLogic (sLit "subfc") reg1 reg2 (RIReg reg3) pprInstr (SUBFE reg1 reg2 reg3) = pprLogic (sLit "subfe") reg1 reg2 (RIReg reg3) @@ -1794,7 +1832,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [ hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "), -@@ -570,8 +635,17 @@ pprInstr (MULLW_MayOflo reg1 reg2 reg3) +@@ -565,8 +631,17 @@ pprInstr (MULLW_MayOflo reg1 reg2 reg3) pprReg reg1, ptext (sLit ", "), ptext (sLit "2, 31, 31") ] ] @@ -1813,7 +1851,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs -- we'll use "andi." instead. pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [ char '\t', -@@ -588,6 +662,17 @@ pprInstr (AND reg1 reg2 ri) = pprLogic ( +@@ -583,6 +658,17 @@ pprInstr (AND reg1 reg2 ri) = pprLogic ( pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri @@ -1831,7 +1869,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs pprInstr (XORIS reg1 reg2 imm) = hcat [ char '\t', ptext (sLit "xoris"), -@@ -612,17 +697,33 @@ pprInstr (EXTS sz reg1 reg2) = hcat [ +@@ -607,17 +693,33 @@ pprInstr (EXTS sz reg1 reg2) = hcat [ pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2 @@ -1869,7 +1907,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, -@@ -654,6 +755,8 @@ pprInstr (FCMP reg1 reg2) = hcat [ +@@ -649,6 +751,8 @@ pprInstr (FCMP reg1 reg2) = hcat [ ] pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2 @@ -1878,7 +1916,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2 pprInstr (CRNOR dst src1 src2) = hcat [ -@@ -684,8 +787,22 @@ pprInstr (FETCHPC reg) = vcat [ +@@ -679,8 +783,22 @@ pprInstr (FETCHPC reg) = vcat [ hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ] ] @@ -1901,7 +1939,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs -- pprInstr _ = panic "pprInstr (ppc)" -@@ -739,9 +856,12 @@ pprFSize FF64 = empty +@@ -734,9 +852,12 @@ pprFSize FF64 = empty pprFSize FF32 = char 's' pprFSize _ = panic "PPC.Ppr.pprFSize: no match" @@ -1918,11 +1956,11 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Ppr.hs + panic $ "PPC.Ppr: 32 bit: Shift by " ++ show i ++ " bits is not allowed." +limitShiftRI _ x = x -Index: ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/PPC/Regs.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/PPC/Regs.hs -+++ ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs -@@ -35,7 +35,7 @@ module PPC.Regs ( +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/PPC/Regs.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/PPC/Regs.hs +@@ -37,7 +37,7 @@ module PPC.Regs ( fits16Bits, makeImmediate, fReg, @@ -1931,7 +1969,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs f1, f20, f21, allocatableRegs -@@ -62,8 +62,8 @@ import FastBool +@@ -64,8 +64,8 @@ import FastBool import FastTypes import Platform @@ -1942,7 +1980,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs -- squeese functions for the graph allocator ----------------------------------- -@@ -145,6 +145,8 @@ data Imm +@@ -147,6 +147,8 @@ data Imm | LO Imm | HI Imm | HA Imm {- high halfword adjusted -} @@ -1951,7 +1989,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs strImmLit :: String -> Imm -@@ -267,9 +269,11 @@ fits16Bits x = x >= -32768 && x < 32768 +@@ -269,9 +271,11 @@ fits16Bits x = x >= -32768 && x < 32768 makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm makeImmediate rep signed x = fmap ImmInt (toI16 rep signed) where @@ -1963,7 +2001,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs narrow W32 True = fromIntegral (fromIntegral x :: Int32) narrow W16 True = fromIntegral (fromIntegral x :: Int16) narrow W8 True = fromIntegral (fromIntegral x :: Int8) -@@ -283,6 +287,12 @@ makeImmediate rep signed x = fmap ImmInt +@@ -285,6 +289,12 @@ makeImmediate rep signed x = fmap ImmInt toI16 W32 False | narrowed >= 0 && narrowed < 65536 = Just narrowed | otherwise = Nothing @@ -1976,7 +2014,7 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs toI16 _ _ = Just narrowed -@@ -294,10 +304,13 @@ point registers. +@@ -296,10 +306,13 @@ point registers. fReg :: Int -> RegNo fReg x = (32 + x) @@ -1991,10 +2029,10 @@ Index: ghc-7.8.4/compiler/nativeGen/PPC/Regs.hs r27 = regSingle 27 r28 = regSingle 28 r30 = regSingle 30 -Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs -+++ ghc-7.8.4/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs @@ -111,7 +111,7 @@ trivColorable platform virtualRegSqueeze ArchX86_64 -> 5 ArchPPC -> 16 @@ -2002,114 +2040,114 @@ Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs - ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" ArchARM _ _ _ -> panic "trivColorable ArchARM" + ArchARM64 -> panic "trivColorable ArchARM64" ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" -@@ -135,7 +135,7 @@ trivColorable platform virtualRegSqueeze +@@ -136,7 +136,7 @@ trivColorable platform virtualRegSqueeze ArchX86_64 -> 0 ArchPPC -> 0 ArchSPARC -> 22 - ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" ArchARM _ _ _ -> panic "trivColorable ArchARM" + ArchARM64 -> panic "trivColorable ArchARM64" ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" -@@ -159,7 +159,7 @@ trivColorable platform virtualRegSqueeze +@@ -161,7 +161,7 @@ trivColorable platform virtualRegSqueeze ArchX86_64 -> 0 ArchPPC -> 26 ArchSPARC -> 11 - ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" ArchARM _ _ _ -> panic "trivColorable ArchARM" + ArchARM64 -> panic "trivColorable ArchARM64" ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" -@@ -183,7 +183,7 @@ trivColorable platform virtualRegSqueeze +@@ -186,7 +186,7 @@ trivColorable platform virtualRegSqueeze ArchX86_64 -> 10 ArchPPC -> 0 ArchSPARC -> 0 - ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" ArchARM _ _ _ -> panic "trivColorable ArchARM" + ArchARM64 -> panic "trivColorable ArchARM64" ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" -Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs -+++ ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs -@@ -74,7 +74,7 @@ maxSpillSlots dflags - ArchPPC -> PPC.Instr.maxSpillSlots dflags +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs +@@ -76,7 +76,7 @@ maxSpillSlots dflags ArchSPARC -> SPARC.Instr.maxSpillSlots dflags ArchARM _ _ _ -> panic "maxSpillSlots ArchARM" + ArchARM64 -> panic "maxSpillSlots ArchARM64" - ArchPPC_64 -> panic "maxSpillSlots ArchPPC_64" + ArchPPC_64 _ -> PPC.Instr.maxSpillSlots dflags ArchAlpha -> panic "maxSpillSlots ArchAlpha" ArchMipseb -> panic "maxSpillSlots ArchMipseb" ArchMipsel -> panic "maxSpillSlots ArchMipsel" -Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/Main.hs +Index: ghc-7.10.1.20150630/compiler/nativeGen/RegAlloc/Linear/Main.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/RegAlloc/Linear/Main.hs -+++ ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/Main.hs -@@ -207,7 +207,7 @@ linearRegAlloc dflags entry_ids block_li - ArchSPARC -> linearRegAlloc' dflags (frInitFreeRegs platform :: SPARC.FreeRegs) entry_ids block_live sccs - ArchPPC -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs) entry_ids block_live sccs - ArchARM _ _ _ -> panic "linearRegAlloc ArchARM" -- ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64" -+ ArchPPC_64 _ -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs) entry_ids block_live sccs - ArchAlpha -> panic "linearRegAlloc ArchAlpha" - ArchMipseb -> panic "linearRegAlloc ArchMipseb" - ArchMipsel -> panic "linearRegAlloc ArchMipsel" -Index: ghc-7.8.4/compiler/nativeGen/TargetReg.hs +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/RegAlloc/Linear/Main.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/RegAlloc/Linear/Main.hs +@@ -211,7 +211,7 @@ linearRegAlloc dflags entry_ids block_li + ArchPPC -> go $ (frInitFreeRegs platform :: PPC.FreeRegs) + ArchARM _ _ _ -> panic "linearRegAlloc ArchARM" + ArchARM64 -> panic "linearRegAlloc ArchARM64" +- ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64" ++ ArchPPC_64 _ -> go $ (frInitFreeRegs platform :: PPC.FreeRegs) + ArchAlpha -> panic "linearRegAlloc ArchAlpha" + ArchMipseb -> panic "linearRegAlloc ArchMipseb" + ArchMipsel -> panic "linearRegAlloc ArchMipsel" +Index: ghc-7.10.1.20150630/compiler/nativeGen/TargetReg.hs =================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/TargetReg.hs -+++ ghc-7.8.4/compiler/nativeGen/TargetReg.hs -@@ -52,7 +52,7 @@ targetVirtualRegSqueeze platform +--- ghc-7.10.1.20150630.orig/compiler/nativeGen/TargetReg.hs ++++ ghc-7.10.1.20150630/compiler/nativeGen/TargetReg.hs +@@ -44,7 +44,7 @@ targetVirtualRegSqueeze platform ArchX86_64 -> X86.virtualRegSqueeze ArchPPC -> PPC.virtualRegSqueeze ArchSPARC -> SPARC.virtualRegSqueeze - ArchPPC_64 -> panic "targetVirtualRegSqueeze ArchPPC_64" + ArchPPC_64 _ -> PPC.virtualRegSqueeze ArchARM _ _ _ -> panic "targetVirtualRegSqueeze ArchARM" + ArchARM64 -> panic "targetVirtualRegSqueeze ArchARM64" ArchAlpha -> panic "targetVirtualRegSqueeze ArchAlpha" - ArchMipseb -> panic "targetVirtualRegSqueeze ArchMipseb" -@@ -68,7 +68,7 @@ targetRealRegSqueeze platform +@@ -61,7 +61,7 @@ targetRealRegSqueeze platform ArchX86_64 -> X86.realRegSqueeze ArchPPC -> PPC.realRegSqueeze ArchSPARC -> SPARC.realRegSqueeze - ArchPPC_64 -> panic "targetRealRegSqueeze ArchPPC_64" + ArchPPC_64 _ -> PPC.realRegSqueeze ArchARM _ _ _ -> panic "targetRealRegSqueeze ArchARM" + ArchARM64 -> panic "targetRealRegSqueeze ArchARM64" ArchAlpha -> panic "targetRealRegSqueeze ArchAlpha" - ArchMipseb -> panic "targetRealRegSqueeze ArchMipseb" -@@ -83,7 +83,7 @@ targetClassOfRealReg platform +@@ -77,7 +77,7 @@ targetClassOfRealReg platform ArchX86_64 -> X86.classOfRealReg platform ArchPPC -> PPC.classOfRealReg ArchSPARC -> SPARC.classOfRealReg - ArchPPC_64 -> panic "targetClassOfRealReg ArchPPC_64" + ArchPPC_64 _ -> PPC.classOfRealReg ArchARM _ _ _ -> panic "targetClassOfRealReg ArchARM" + ArchARM64 -> panic "targetClassOfRealReg ArchARM64" ArchAlpha -> panic "targetClassOfRealReg ArchAlpha" - ArchMipseb -> panic "targetClassOfRealReg ArchMipseb" -@@ -98,7 +98,7 @@ targetMkVirtualReg platform +@@ -93,7 +93,7 @@ targetMkVirtualReg platform ArchX86_64 -> X86.mkVirtualReg ArchPPC -> PPC.mkVirtualReg ArchSPARC -> SPARC.mkVirtualReg - ArchPPC_64 -> panic "targetMkVirtualReg ArchPPC_64" + ArchPPC_64 _ -> PPC.mkVirtualReg ArchARM _ _ _ -> panic "targetMkVirtualReg ArchARM" + ArchARM64 -> panic "targetMkVirtualReg ArchARM64" ArchAlpha -> panic "targetMkVirtualReg ArchAlpha" - ArchMipseb -> panic "targetMkVirtualReg ArchMipseb" -@@ -113,7 +113,7 @@ targetRegDotColor platform +@@ -109,7 +109,7 @@ targetRegDotColor platform ArchX86_64 -> X86.regDotColor platform ArchPPC -> PPC.regDotColor ArchSPARC -> SPARC.regDotColor - ArchPPC_64 -> panic "targetRegDotColor ArchPPC_64" + ArchPPC_64 _ -> PPC.regDotColor ArchARM _ _ _ -> panic "targetRegDotColor ArchARM" + ArchARM64 -> panic "targetRegDotColor ArchARM64" ArchAlpha -> panic "targetRegDotColor ArchAlpha" - ArchMipseb -> panic "targetRegDotColor ArchMipseb" -Index: ghc-7.8.4/compiler/utils/Platform.hs +Index: ghc-7.10.1.20150630/compiler/utils/Platform.hs =================================================================== ---- ghc-7.8.4.orig/compiler/utils/Platform.hs -+++ ghc-7.8.4/compiler/utils/Platform.hs +--- ghc-7.10.1.20150630.orig/compiler/utils/Platform.hs ++++ ghc-7.10.1.20150630/compiler/utils/Platform.hs @@ -8,6 +8,7 @@ module Platform ( ArmISA(..), ArmISAExt(..), @@ -2118,7 +2156,7 @@ Index: ghc-7.8.4/compiler/utils/Platform.hs target32Bit, isARM, -@@ -46,6 +47,8 @@ data Arch +@@ -47,6 +48,8 @@ data Arch | ArchX86_64 | ArchPPC | ArchPPC_64 @@ -2127,7 +2165,7 @@ Index: ghc-7.8.4/compiler/utils/Platform.hs | ArchSPARC | ArchARM { armISA :: ArmISA -@@ -104,10 +107,18 @@ data ArmABI +@@ -107,10 +110,18 @@ data ArmABI | HARD deriving (Read, Show, Eq) @@ -2147,11 +2185,11 @@ Index: ghc-7.8.4/compiler/utils/Platform.hs osElfTarget :: OS -> Bool osElfTarget OSLinux = True osElfTarget OSFreeBSD = True -Index: ghc-7.8.4/configure.ac +Index: ghc-7.10.1.20150630/configure.ac =================================================================== ---- ghc-7.8.4.orig/configure.ac -+++ ghc-7.8.4/configure.ac -@@ -288,7 +288,7 @@ AC_SUBST(SOLARIS_BROKEN_SHLD) +--- ghc-7.10.1.20150630.orig/configure.ac ++++ ghc-7.10.1.20150630/configure.ac +@@ -241,7 +241,7 @@ AC_SUBST(SOLARIS_BROKEN_SHLD) dnl ** Do an unregisterised build? dnl -------------------------------------------------------------- case "$HostArch" in @@ -2160,11 +2198,11 @@ Index: ghc-7.8.4/configure.ac UnregisterisedDefault=NO ;; *) -Index: ghc-7.8.4/includes/CodeGen.Platform.hs +Index: ghc-7.10.1.20150630/includes/CodeGen.Platform.hs =================================================================== ---- ghc-7.8.4.orig/includes/CodeGen.Platform.hs -+++ ghc-7.8.4/includes/CodeGen.Platform.hs -@@ -804,6 +804,9 @@ freeReg 1 = fastBool False -- The Stack +--- ghc-7.10.1.20150630.orig/includes/CodeGen.Platform.hs ++++ ghc-7.10.1.20150630/includes/CodeGen.Platform.hs +@@ -881,6 +881,9 @@ freeReg 1 = fastBool False -- The Stack # if !MACHREGS_darwin -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that freeReg 2 = fastBool False @@ -2174,10 +2212,10 @@ Index: ghc-7.8.4/includes/CodeGen.Platform.hs -- at least linux in -fPIC relies on r30 in PLT stubs freeReg 30 = fastBool False # endif -Index: ghc-7.8.4/includes/stg/HaskellMachRegs.h +Index: ghc-7.10.1.20150630/includes/stg/HaskellMachRegs.h =================================================================== ---- ghc-7.8.4.orig/includes/stg/HaskellMachRegs.h -+++ ghc-7.8.4/includes/stg/HaskellMachRegs.h +--- ghc-7.10.1.20150630.orig/includes/stg/HaskellMachRegs.h ++++ ghc-7.10.1.20150630/includes/stg/HaskellMachRegs.h @@ -35,7 +35,8 @@ #define MACHREGS_i386 i386_TARGET_ARCH @@ -2187,11 +2225,11 @@ Index: ghc-7.8.4/includes/stg/HaskellMachRegs.h + || powerpc64le_TARGET_ARCH || rs6000_TARGET_ARCH) #define MACHREGS_sparc sparc_TARGET_ARCH #define MACHREGS_arm arm_TARGET_ARCH - #define MACHREGS_darwin darwin_TARGET_OS -Index: ghc-7.8.4/includes/stg/RtsMachRegs.h + #define MACHREGS_aarch64 aarch64_TARGET_ARCH +Index: ghc-7.10.1.20150630/includes/stg/RtsMachRegs.h =================================================================== ---- ghc-7.8.4.orig/includes/stg/RtsMachRegs.h -+++ ghc-7.8.4/includes/stg/RtsMachRegs.h +--- ghc-7.10.1.20150630.orig/includes/stg/RtsMachRegs.h ++++ ghc-7.10.1.20150630/includes/stg/RtsMachRegs.h @@ -41,7 +41,8 @@ #define MACHREGS_i386 i386_HOST_ARCH @@ -2201,12 +2239,12 @@ Index: ghc-7.8.4/includes/stg/RtsMachRegs.h + || powerpc64le_HOST_ARCH || rs6000_HOST_ARCH) #define MACHREGS_sparc sparc_HOST_ARCH #define MACHREGS_arm arm_HOST_ARCH - #define MACHREGS_darwin darwin_HOST_OS -Index: ghc-7.8.4/includes/stg/SMP.h + #define MACHREGS_aarch64 aarch64_HOST_ARCH +Index: ghc-7.10.1.20150630/includes/stg/SMP.h =================================================================== ---- ghc-7.8.4.orig/includes/stg/SMP.h -+++ ghc-7.8.4/includes/stg/SMP.h -@@ -124,6 +124,14 @@ xchg(StgPtr p, StgWord w) +--- ghc-7.10.1.20150630.orig/includes/stg/SMP.h ++++ ghc-7.10.1.20150630/includes/stg/SMP.h +@@ -127,6 +127,14 @@ xchg(StgPtr p, StgWord w) :"=&r" (result) :"r" (w), "r" (p) ); @@ -2221,7 +2259,7 @@ Index: ghc-7.8.4/includes/stg/SMP.h #elif sparc_HOST_ARCH result = w; __asm__ __volatile__ ( -@@ -190,6 +198,20 @@ cas(StgVolatilePtr p, StgWord o, StgWord +@@ -208,6 +216,20 @@ cas(StgVolatilePtr p, StgWord o, StgWord :"cc", "memory" ); return result; @@ -2241,17 +2279,17 @@ Index: ghc-7.8.4/includes/stg/SMP.h + return result; #elif sparc_HOST_ARCH __asm__ __volatile__ ( - "cas [%1], %2, %0" -@@ -304,7 +326,7 @@ EXTERN_INLINE void - write_barrier(void) { - #if i386_HOST_ARCH || x86_64_HOST_ARCH + "cas [%1], %2, %0" +@@ -345,7 +367,7 @@ write_barrier(void) { + return; + #elif i386_HOST_ARCH || x86_64_HOST_ARCH __asm__ __volatile__ ("" : : : "memory"); -#elif powerpc_HOST_ARCH +#elif powerpc_HOST_ARCH || powerpc64_HOST_ARCH || powerpc64le_HOST_ARCH __asm__ __volatile__ ("lwsync" : : : "memory"); #elif sparc_HOST_ARCH /* Sparc in TSO mode does not require store/store barriers. */ -@@ -326,7 +348,7 @@ store_load_barrier(void) { +@@ -367,7 +389,7 @@ store_load_barrier(void) { __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); #elif x86_64_HOST_ARCH __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); @@ -2260,7 +2298,7 @@ Index: ghc-7.8.4/includes/stg/SMP.h __asm__ __volatile__ ("sync" : : : "memory"); #elif sparc_HOST_ARCH __asm__ __volatile__ ("membar #StoreLoad" : : : "memory"); -@@ -345,7 +367,7 @@ load_load_barrier(void) { +@@ -390,7 +412,7 @@ load_load_barrier(void) { __asm__ __volatile__ ("" : : : "memory"); #elif x86_64_HOST_ARCH __asm__ __volatile__ ("" : : : "memory"); @@ -2269,11 +2307,11 @@ Index: ghc-7.8.4/includes/stg/SMP.h __asm__ __volatile__ ("lwsync" : : : "memory"); #elif sparc_HOST_ARCH /* Sparc in TSO mode does not require load/load barriers. */ -Index: ghc-7.8.4/mk/config.mk.in +Index: ghc-7.10.1.20150630/mk/config.mk.in =================================================================== ---- ghc-7.8.4.orig/mk/config.mk.in -+++ ghc-7.8.4/mk/config.mk.in -@@ -161,9 +161,9 @@ GhcUnregisterised=@Unregisterised@ +--- ghc-7.10.1.20150630.orig/mk/config.mk.in ++++ ghc-7.10.1.20150630/mk/config.mk.in +@@ -159,9 +159,9 @@ GhcUnregisterised=@Unregisterised@ # (as well as a C backend) # # Target platforms supported: @@ -2285,25 +2323,25 @@ Index: ghc-7.8.4/mk/config.mk.in OsSupportsNCG=$(strip $(patsubst $(TargetOS_CPP), YES, $(patsubst ios,,$(patsubst aix,,$(TargetOS_CPP))))) GhcWithNativeCodeGen := $(strip\ -@@ -174,7 +174,7 @@ HaveLibDL = @HaveLibDL@ +@@ -172,7 +172,7 @@ HaveLibDL = @HaveLibDL@ # ArchSupportsSMP should be set iff there is support for that arch in # includes/stg/SMP.h --ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc arm))) -+ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le arm))) +-ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc arm aarch64))) ++ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le arm aarch64))) GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO)) -@@ -182,7 +182,7 @@ GhcWithSMP := $(strip $(if $(filter YESN +@@ -180,7 +180,7 @@ GhcWithSMP := $(strip $(if $(filter YESN # has support for this OS/ARCH combination. OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 cygwin32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu))) --ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc sparc sparc64 arm))) -+ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm))) +-ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc sparc sparc64 arm aarch64))) ++ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm aarch64))) ifeq "$(OsSupportsGHCi)$(ArchSupportsGHCi)" "YESYES" GhcWithInterpreter=YES -@@ -195,7 +195,7 @@ endif +@@ -193,7 +193,7 @@ endif # (see TABLES_NEXT_TO_CODE in the RTS). Whether we actually compile for # TABLES_NEXT_TO_CODE depends on whether we're building unregisterised # code or not, which may be decided by options to the compiler later. @@ -2312,10 +2350,10 @@ Index: ghc-7.8.4/mk/config.mk.in GhcEnableTablesNextToCode=NO else GhcEnableTablesNextToCode=YES -Index: ghc-7.8.4/rts/StgCRun.c +Index: ghc-7.10.1.20150630/rts/StgCRun.c =================================================================== ---- ghc-7.8.4.orig/rts/StgCRun.c -+++ ghc-7.8.4/rts/StgCRun.c +--- ghc-7.10.1.20150630.orig/rts/StgCRun.c ++++ ghc-7.10.1.20150630/rts/StgCRun.c @@ -662,11 +662,19 @@ StgRunIsImplementedInAssembler(void) } @@ -2337,10 +2375,10 @@ Index: ghc-7.8.4/rts/StgCRun.c /* ----------------------------------------------------------------------------- ARM architecture -------------------------------------------------------------------------- */ -Index: ghc-7.8.4/rts/StgCRunAsm.S +Index: ghc-7.10.1.20150630/rts/StgCRunAsm.S =================================================================== --- /dev/null -+++ ghc-7.8.4/rts/StgCRunAsm.S ++++ ghc-7.10.1.20150630/rts/StgCRunAsm.S @@ -0,0 +1,114 @@ +#include "ghcconfig.h" +#include "rts/Constants.h" @@ -2456,10 +2494,10 @@ Index: ghc-7.8.4/rts/StgCRunAsm.S +#endif + +#endif -Index: ghc-7.8.4/rts/ghc.mk +Index: ghc-7.10.1.20150630/rts/ghc.mk =================================================================== ---- ghc-7.8.4.orig/rts/ghc.mk -+++ ghc-7.8.4/rts/ghc.mk +--- ghc-7.10.1.20150630.orig/rts/ghc.mk ++++ ghc-7.10.1.20150630/rts/ghc.mk @@ -45,6 +45,9 @@ ifneq "$(PORTING_HOST)" "YES" ifneq "$(findstring $(TargetArch_CPP), i386 powerpc powerpc64)" "" rts_S_SRCS += rts/AdjustorAsm.S @@ -2470,29 +2508,3 @@ Index: ghc-7.8.4/rts/ghc.mk endif ifeq "$(GhcUnregisterised)" "YES" -Index: ghc-7.8.4/compiler/nativeGen/AsmCodeGen.lhs -=================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/AsmCodeGen.lhs -+++ ghc-7.8.4/compiler/nativeGen/AsmCodeGen.lhs -@@ -166,7 +166,7 @@ nativeCodeGen dflags this_mod h us cmms - ArchPPC -> nCG' (ppcNcgImpl dflags) - ArchSPARC -> nCG' (sparcNcgImpl dflags) - ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" -- ArchPPC_64 -> panic "nativeCodeGen: No NCG for PPC 64" -+ ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags) - ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" - ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" - ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" -Index: ghc-7.8.4/compiler/llvmGen/LlvmCodeGen/Ppr.hs -=================================================================== ---- ghc-7.8.4.orig/compiler/llvmGen/LlvmCodeGen/Ppr.hs -+++ ghc-7.8.4/compiler/llvmGen/LlvmCodeGen/Ppr.hs -@@ -64,7 +64,7 @@ moduleLayout = sdocWithPlatform $ \platf - Platform { platformArch = ArchX86, platformOS = OSiOS } -> - text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128-n8:16:32\"" - $+$ text "target triple = \"i386-apple-darwin11\"" -- Platform { platformArch = ArchPPC_64 , platformOS = OSLinux } -> -+ Platform { platformArch = ArchPPC_64 ELF_V1, platformOS = OSLinux } -> - text "target datalayout = \"E-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v128:128:128-n32:64\"" - $+$ text "target triple = \"powerpc64-unknown-linux-gnu\"" - _ -> diff --git a/D349.patch b/D349.patch deleted file mode 100644 index 8361426..0000000 --- a/D349.patch +++ /dev/null @@ -1,293 +0,0 @@ -Index: ghc-7.8.4/compiler/ghci/Linker.lhs -=================================================================== ---- ghc-7.8.4.orig/compiler/ghci/Linker.lhs -+++ ghc-7.8.4/compiler/ghci/Linker.lhs -@@ -123,7 +123,10 @@ data PersistentLinkerState - -- The currently-loaded packages; always object code - -- Held, as usual, in dependency order; though I am not sure if - -- that is really important -- pkgs_loaded :: ![PackageId] -+ pkgs_loaded :: ![PackageId], -+ -- we need to remember the name of the last temporary DLL/.so -+ -- so we can link it -+ last_temp_so :: !(Maybe FilePath) - } - - emptyPLS :: DynFlags -> PersistentLinkerState -@@ -132,7 +135,8 @@ emptyPLS _ = PersistentLinkerState { - itbl_env = emptyNameEnv, - pkgs_loaded = init_pkgs, - bcos_loaded = [], -- objs_loaded = [] } -+ objs_loaded = [], -+ last_temp_so = Nothing } - - -- Packages that don't need loading, because the compiler - -- shares them with the interpreted program. -@@ -314,14 +318,15 @@ reallyInitDynLinker dflags = - ; if null cmdline_lib_specs then return pls - else do - -- { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs -+ { pls1 <- foldM (preloadLib dflags lib_paths framework_paths) pls -+ cmdline_lib_specs - ; maybePutStr dflags "final link ... " - ; ok <- resolveObjs - - ; if succeeded ok then maybePutStrLn dflags "done" - else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed") - -- ; return pls -+ ; return pls1 - }} - - -@@ -360,19 +365,22 @@ classifyLdInput dflags f - return Nothing - where platform = targetPlatform dflags - --preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO () --preloadLib dflags lib_paths framework_paths lib_spec -+preloadLib :: DynFlags -> [String] -> [String] -> PersistentLinkerState -+ -> LibrarySpec -> IO (PersistentLinkerState) -+preloadLib dflags lib_paths framework_paths pls lib_spec - = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ") - case lib_spec of - Object static_ish -- -> do b <- preload_static lib_paths static_ish -+ -> do (b, pls1) <- preload_static lib_paths static_ish - maybePutStrLn dflags (if b then "done" - else "not found") -+ return pls1 - - Archive static_ish - -> do b <- preload_static_archive lib_paths static_ish - maybePutStrLn dflags (if b then "done" - else "not found") -+ return pls - - DLL dll_unadorned - -> do maybe_errstr <- loadDLL (mkSOName platform dll_unadorned) -@@ -388,12 +396,14 @@ preloadLib dflags lib_paths framework_pa - case err2 of - Nothing -> maybePutStrLn dflags "done" - Just _ -> preloadFailed mm lib_paths lib_spec -+ return pls - - DLLPath dll_path - -> do maybe_errstr <- loadDLL dll_path - case maybe_errstr of - Nothing -> maybePutStrLn dflags "done" - Just mm -> preloadFailed mm lib_paths lib_spec -+ return pls - - Framework framework -> - if platformUsesFrameworks (targetPlatform dflags) -@@ -401,6 +411,7 @@ preloadLib dflags lib_paths framework_pa - case maybe_errstr of - Nothing -> maybePutStrLn dflags "done" - Just mm -> preloadFailed mm framework_paths lib_spec -+ return pls - else panic "preloadLib Framework" - - where -@@ -420,11 +431,13 @@ preloadLib dflags lib_paths framework_pa - -- Not interested in the paths in the static case. - preload_static _paths name - = do b <- doesFileExist name -- if not b then return False -- else do if dynamicGhc -- then dynLoadObjs dflags [name] -- else loadObj name -- return True -+ if not b then return (False, pls) -+ else if dynamicGhc -+ then do pls1 <- dynLoadObjs dflags pls [name] -+ return (True, pls1) -+ else do loadObj name -+ return (True, pls) -+ - preload_static_archive _paths name - = do b <- doesFileExist name - if not b then return False -@@ -791,8 +804,8 @@ dynLinkObjs dflags pls objs = do - wanted_objs = map nameOfObject unlinkeds - - if dynamicGhc -- then do dynLoadObjs dflags wanted_objs -- return (pls1, Succeeded) -+ then do pls2 <- dynLoadObjs dflags pls1 wanted_objs -+ return (pls2, Succeeded) - else do mapM_ loadObj wanted_objs - - -- Link them all together -@@ -806,9 +819,11 @@ dynLinkObjs dflags pls objs = do - pls2 <- unload_wkr dflags [] pls1 - return (pls2, Failed) - --dynLoadObjs :: DynFlags -> [FilePath] -> IO () --dynLoadObjs _ [] = return () --dynLoadObjs dflags objs = do -+ -+dynLoadObjs :: DynFlags -> PersistentLinkerState -> [FilePath] -+ -> IO PersistentLinkerState -+dynLoadObjs _ pls [] = return pls -+dynLoadObjs dflags pls objs = do - let platform = targetPlatform dflags - soFile <- newTempName dflags (soExt platform) - let -- When running TH for a non-dynamic way, we still need to make -@@ -816,10 +831,22 @@ dynLoadObjs dflags objs = do - -- Opt_Static off - dflags1 = gopt_unset dflags Opt_Static - dflags2 = dflags1 { -- -- We don't want to link the ldInputs in; we'll -- -- be calling dynLoadObjs with any objects that -- -- need to be linked. -- ldInputs = [], -+ -- We don't want the original ldInputs in -+ -- (they're already linked in), but we do want -+ -- to link against the previous dynLoadObjs -+ -- library if there was one, so that the linker -+ -- can resolve dependencies when it loads this -+ -- library. -+ ldInputs = -+ case last_temp_so pls of -+ Nothing -> [] -+ Just so -> -+ let (lp, l) = splitFileName so in -+ [ Option ("-L" ++ lp) -+ , Option ("-Wl,-rpath") -+ , Option ("-Wl," ++ lp) -+ , Option ("-l:" ++ l) -+ ], - -- Even if we're e.g. profiling, we still want - -- the vanilla dynamic libraries, so we set the - -- ways / build tag to be just WayDyn. -@@ -831,7 +858,7 @@ dynLoadObjs dflags objs = do - consIORef (filesToNotIntermediateClean dflags) soFile - m <- loadDLL soFile - case m of -- Nothing -> return () -+ Nothing -> return pls { last_temp_so = Just soFile } - Just err -> panic ("Loading temp shared object failed: " ++ err) - - rmDupLinkables :: [Linkable] -- Already loaded -Index: ghc-7.8.4/compiler/main/SysTools.lhs -=================================================================== ---- ghc-7.8.4.orig/compiler/main/SysTools.lhs -+++ ghc-7.8.4/compiler/main/SysTools.lhs -@@ -1416,6 +1416,7 @@ linkDynLib dflags0 o_files dep_packages - in package_hs_libs ++ extra_libs ++ other_flags - - -- probably _stub.o files -+ -- and last temporary shaerd object file - let extra_ld_inputs = ldInputs dflags - - case os of -@@ -1533,8 +1534,8 @@ linkDynLib dflags0 o_files dep_packages - -- Set the library soname. We use -h rather than -soname as - -- Solaris 10 doesn't support the latter: - ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ] -- ++ map Option lib_path_opts - ++ extra_ld_inputs -+ ++ map Option lib_path_opts - ++ map Option pkg_lib_path_opts - ++ map Option pkg_link_opts - ) -Index: ghc-7.8.4/rts/Linker.c -=================================================================== ---- ghc-7.8.4.orig/rts/Linker.c -+++ ghc-7.8.4/rts/Linker.c -@@ -1777,7 +1777,7 @@ internal_dlopen(const char *dll_name) - // (see POSIX also) - - ACQUIRE_LOCK(&dl_mutex); -- hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL); -+ hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - - errmsg = NULL; - if (hdl == NULL) { -@@ -1787,11 +1787,12 @@ internal_dlopen(const char *dll_name) - errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); - strcpy(errmsg_copy, errmsg); - errmsg = errmsg_copy; -+ } else { -+ o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); -+ o_so->handle = hdl; -+ o_so->next = openedSOs; -+ openedSOs = o_so; - } -- o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); -- o_so->handle = hdl; -- o_so->next = openedSOs; -- openedSOs = o_so; - - RELEASE_LOCK(&dl_mutex); - //--------------- End critical section ------------------- -@@ -1799,14 +1800,39 @@ internal_dlopen(const char *dll_name) - return errmsg; - } - -+/* -+ Note [RTLD_LOCAL] -+ -+ In GHCi we want to be able to override previous .so's with newly -+ loaded .so's when we recompile something. This further implies that -+ when we look up a symbol in internal_dlsym() we have to iterate -+ through the loaded libraries (in order from most recently loaded to -+ oldest) looking up the symbol in each one until we find it. -+ -+ However, this can cause problems for some symbols that are copied -+ by the linker into the executable image at runtime - see #8935 for a -+ lengthy discussion. To solve that problem we need to look up -+ symbols in the main executable *first*, before attempting to look -+ them up in the loaded .so's. But in order to make that work, we -+ have to always call dlopen with RTLD_LOCAL, so that the loaded -+ libraries don't populate the global symbol table. -+*/ -+ - static void * --internal_dlsym(void *hdl, const char *symbol) { -+internal_dlsym(const char *symbol) { - OpenedSO* o_so; - void *v; - - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); - dlerror(); -+ // look in program first -+ v = dlsym(dl_prog_handle, symbol); -+ if (dlerror() == NULL) { -+ RELEASE_LOCK(&dl_mutex); -+ return v; -+ } -+ - for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { - v = dlsym(o_so->handle, symbol); - if (dlerror() == NULL) { -@@ -1814,7 +1840,6 @@ internal_dlsym(void *hdl, const char *sy - return v; - } - } -- v = dlsym(hdl, symbol); - RELEASE_LOCK(&dl_mutex); - return v; - } -@@ -1982,7 +2007,7 @@ lookupSymbol( char *lbl ) - if (!ghciLookupSymbolTable(symhash, lbl, &val)) { - IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n")); - # if defined(OBJFORMAT_ELF) -- return internal_dlsym(dl_prog_handle, lbl); -+ return internal_dlsym(lbl); - # elif defined(OBJFORMAT_MACHO) - # if HAVE_DLFCN_H - /* On OS X 10.3 and later, we use dlsym instead of the old legacy -@@ -1996,7 +2021,7 @@ lookupSymbol( char *lbl ) - */ - IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl)); - ASSERT(lbl[0] == '_'); -- return internal_dlsym(dl_prog_handle, lbl + 1); -+ return internal_dlsym(lbl + 1); - # else - if (NSIsSymbolNameDefined(lbl)) { - NSSymbol symbol = NSLookupAndBindSymbol(lbl); diff --git a/D560.patch b/D560.patch deleted file mode 100644 index 5f7a86c..0000000 --- a/D560.patch +++ /dev/null @@ -1,320 +0,0 @@ -Index: ghc-7.8.3/compiler/cmm/CLabel.hs -=================================================================== ---- ghc-7.8.3.orig/compiler/cmm/CLabel.hs -+++ ghc-7.8.3/compiler/cmm/CLabel.hs -@@ -1158,7 +1158,8 @@ pprDynamicLinkerAsmLabel platform dllInf - else if osElfTarget (platformOS platform) - then if platformArch platform == ArchPPC - then case dllInfo of -- CodeStub -> ppr lbl <> text "@plt" -+ CodeStub -> -- See Note [.LCTOC1 in PPC PIC code] -+ ppr lbl <> text "+32768@plt" - SymbolPtr -> text ".LC_" <> ppr lbl - _ -> panic "pprDynamicLinkerAsmLabel" - else if platformArch platform == ArchX86_64 -Index: ghc-7.8.3/compiler/nativeGen/PIC.hs -=================================================================== ---- ghc-7.8.3.orig/compiler/nativeGen/PIC.hs -+++ ghc-7.8.3/compiler/nativeGen/PIC.hs -@@ -54,7 +54,6 @@ import qualified X86.Instr as X86 - - import Platform - import Instruction --import Size - import Reg - import NCGMonad - -@@ -468,11 +467,8 @@ pprGotDeclaration dflags ArchX86 OSDarwi - pprGotDeclaration _ _ OSDarwin - = empty - ---- pprGotDeclaration -+-- Emit GOT declaration - -- Output whatever needs to be output once per .s file. ---- The .LCTOC1 label is defined to point 32768 bytes into the table, ---- to make the most of the PPC's 16-bit displacements. ---- Only needed for PIC. - pprGotDeclaration dflags arch os - | osElfTarget os - , arch /= ArchPPC_64 -@@ -482,6 +478,7 @@ pprGotDeclaration dflags arch os - | osElfTarget os - , arch /= ArchPPC_64 - = vcat [ -+ -- See Note [.LCTOC1 in PPC PIC code] - ptext (sLit ".section \".got2\",\"aw\""), - ptext (sLit ".LCTOC1 = .+32768") ] - -@@ -688,12 +685,7 @@ pprImportedSymbol _ _ _ - - - -- Get a pointer to our own fake GOT, which is defined on a per-module basis. ---- This is exactly how GCC does it, and it's quite horrible: ---- We first fetch the address of a local label (mkPicBaseLabel). ---- Then we add a 16-bit offset to that to get the address of a .long that we ---- define in .text space right next to the proc. This .long literal contains ---- the (32-bit) offset from our local label to our global offset table ---- (.LCTOC1 aka gotOffLabel). -+-- This is exactly how GCC does it in linux. - - initializePicBase_ppc - :: Arch -> OS -> Reg -@@ -704,18 +696,9 @@ initializePicBase_ppc ArchPPC os picReg - (CmmProc info lab live (ListGraph blocks) : statics) - | osElfTarget os - = do -- dflags <- getDynFlags -- gotOffLabel <- getNewLabelNat -- tmp <- getNewRegNat $ intSize (wordWidth dflags) - let -- gotOffset = CmmData Text $ Statics gotOffLabel [ -- CmmStaticLit (CmmLabelDiffOff gotLabel -- mkPicBaseLabel -- 0) -- ] -- offsetToOffset -- = PPC.ImmConstantDiff -- (PPC.ImmCLbl gotOffLabel) -+ gotOffset = PPC.ImmConstantDiff -+ (PPC.ImmCLbl gotLabel) - (PPC.ImmCLbl mkPicBaseLabel) - - blocks' = case blocks of -@@ -726,15 +709,23 @@ initializePicBase_ppc ArchPPC os picReg - | bID `mapMember` info = fetchPC b - | otherwise = b - -+ -- GCC does PIC prologs thusly: -+ -- bcl 20,31,.L1 -+ -- .L1: -+ -- mflr 30 -+ -- addis 30,30,.LCTOC1-.L1@ha -+ -- addi 30,30,.LCTOC1-.L1@l -+ -- TODO: below we use it over temporary register, -+ -- it can and should be optimised by picking -+ -- correct PIC reg. - fetchPC (BasicBlock bID insns) = - BasicBlock bID (PPC.FETCHPC picReg -- : PPC.ADDIS tmp picReg (PPC.HI offsetToOffset) -- : PPC.LD PPC.archWordSize tmp -- (PPC.AddrRegImm tmp (PPC.LO offsetToOffset)) -- : PPC.ADD picReg picReg (PPC.RIReg picReg) -+ : PPC.ADDIS picReg picReg (PPC.HA gotOffset) -+ : PPC.ADDI picReg picReg (PPC.LO gotOffset) -+ : PPC.MR PPC.r30 picReg - : insns) - -- return (CmmProc info lab live (ListGraph blocks') : gotOffset : statics) -+ return (CmmProc info lab live (ListGraph blocks') : statics) - - - initializePicBase_ppc ArchPPC OSDarwin picReg -Index: ghc-7.8.3/compiler/nativeGen/PPC/CodeGen.hs -=================================================================== ---- ghc-7.8.3.orig/compiler/nativeGen/PPC/CodeGen.hs -+++ ghc-7.8.3/compiler/nativeGen/PPC/CodeGen.hs -@@ -54,7 +54,7 @@ import Outputable - import Unique - import DynFlags - --import Control.Monad ( mapAndUnzipM ) -+import Control.Monad ( mapAndUnzipM, when ) - import Data.Bits - import Data.Word - -@@ -355,6 +355,19 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1,e2] - ADDE rhi r1hi r2hi ] - return (ChildCode64 code rlo) - -+iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do -+ ChildCode64 code1 r1lo <- iselExpr64 e1 -+ ChildCode64 code2 r2lo <- iselExpr64 e2 -+ (rlo,rhi) <- getNewRegPairNat II32 -+ let -+ r1hi = getHiVRegFromLo r1lo -+ r2hi = getHiVRegFromLo r2lo -+ code = code1 `appOL` -+ code2 `appOL` -+ toOL [ SUBFC rlo r2lo r1lo, -+ SUBFE rhi r2hi r1hi ] -+ return (ChildCode64 code rlo) -+ - iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do - (expr_reg,expr_code) <- getSomeReg expr - (rlo, rhi) <- getNewRegPairNat II32 -@@ -927,8 +940,12 @@ genCCall' dflags gcp target dest_regs ar - (toOL []) [] - - (labelOrExpr, reduceToFF32) <- case target of -- ForeignTarget (CmmLit (CmmLabel lbl)) _ -> return (Left lbl, False) -- ForeignTarget expr _ -> return (Right expr, False) -+ ForeignTarget (CmmLit (CmmLabel lbl)) _ -> do -+ uses_pic_base_implicitly -+ return (Left lbl, False) -+ ForeignTarget expr _ -> do -+ uses_pic_base_implicitly -+ return (Right expr, False) - PrimTarget mop -> outOfLineMachOp mop - - let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode -@@ -949,6 +966,13 @@ genCCall' dflags gcp target dest_regs ar - where - platform = targetPlatform dflags - -+ uses_pic_base_implicitly = do -+ -- See Note [implicit register in PPC PIC code] -+ -- on why we claim to use PIC register here -+ when (gopt Opt_PIC dflags) $ do -+ _ <- getPicBaseNat archWordSize -+ return () -+ - initialStackOffset = case gcp of - GCPDarwin -> 24 - GCPLinux -> 8 -@@ -1432,3 +1456,21 @@ coerceFP2Int _ toRep x = do - -- read low word of value (high word is undefined) - LD II32 dst (spRel dflags 3)] - return (Any (intSize toRep) code') -+ -+-- Note [.LCTOC1 in PPC PIC code] -+-- The .LCTOC1 label is defined to point 32768 bytes into the GOT table -+-- to make the most of the PPC's 16-bit displacements. -+-- As 16-bit signed offset is used (usually via addi/lwz instructions) -+-- first element will have '-32768' offset against .LCTOC1. -+ -+-- Note [implicit register in PPC PIC code] -+-- PPC generates calls by labels in assembly -+-- in form of: -+-- bl puts+32768@plt -+-- in this form it's not seen directly (by GHC NCG) -+-- that r30 (PicBaseReg) is used, -+-- but r30 is a required part of PLT code setup: -+-- puts+32768@plt: -+-- lwz r11,-30484(r30) ; offset in .LCTOC1 -+-- mtctr r11 -+-- bctr -Index: ghc-7.8.3/compiler/nativeGen/PPC/Instr.hs -=================================================================== ---- ghc-7.8.3.orig/compiler/nativeGen/PPC/Instr.hs -+++ ghc-7.8.3/compiler/nativeGen/PPC/Instr.hs -@@ -203,8 +203,11 @@ data Instr - | ADD Reg Reg RI -- dst, src1, src2 - | ADDC Reg Reg Reg -- (carrying) dst, src1, src2 - | ADDE Reg Reg Reg -- (extend) dst, src1, src2 -+ | ADDI Reg Reg Imm -- Add Immediate dst, src1, src2 - | ADDIS Reg Reg Imm -- Add Immediate Shifted dst, src1, src2 - | SUBF Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1 -+ | SUBFC Reg Reg Reg -- (carrying) dst, src1, src2 ; dst = src2 - src1 -+ | SUBFE Reg Reg Reg -- (extend) dst, src1, src2 ; dst = src2 - src1 - | MULLW Reg Reg RI - | DIVW Reg Reg Reg - | DIVWU Reg Reg Reg -@@ -282,8 +285,11 @@ ppc_regUsageOfInstr platform instr - ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) - ADDC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) - ADDE reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) -+ ADDI reg1 reg2 _ -> usage ([reg2], [reg1]) - ADDIS reg1 reg2 _ -> usage ([reg2], [reg1]) - SUBF reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) -+ SUBFC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) -+ SUBFE reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) - MULLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) - DIVW reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) - DIVWU reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) -@@ -356,8 +362,11 @@ ppc_patchRegsOfInstr instr env - ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri) - ADDC reg1 reg2 reg3 -> ADDC (env reg1) (env reg2) (env reg3) - ADDE reg1 reg2 reg3 -> ADDE (env reg1) (env reg2) (env reg3) -+ ADDI reg1 reg2 imm -> ADDI (env reg1) (env reg2) imm - ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm - SUBF reg1 reg2 reg3 -> SUBF (env reg1) (env reg2) (env reg3) -+ SUBFC reg1 reg2 reg3 -> SUBFC (env reg1) (env reg2) (env reg3) -+ SUBFE reg1 reg2 reg3 -> SUBFE (env reg1) (env reg2) (env reg3) - MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri) - DIVW reg1 reg2 reg3 -> DIVW (env reg1) (env reg2) (env reg3) - DIVWU reg1 reg2 reg3 -> DIVWU (env reg1) (env reg2) (env reg3) -Index: ghc-7.8.3/compiler/nativeGen/PPC/Ppr.hs -=================================================================== ---- ghc-7.8.3.orig/compiler/nativeGen/PPC/Ppr.hs -+++ ghc-7.8.3/compiler/nativeGen/PPC/Ppr.hs -@@ -530,6 +530,16 @@ pprInstr (BCTRL _) = hcat [ - ptext (sLit "bctrl") - ] - pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri -+pprInstr (ADDI reg1 reg2 imm) = hcat [ -+ char '\t', -+ ptext (sLit "addi"), -+ char '\t', -+ pprReg reg1, -+ ptext (sLit ", "), -+ pprReg reg2, -+ ptext (sLit ", "), -+ pprImm imm -+ ] - pprInstr (ADDIS reg1 reg2 imm) = hcat [ - char '\t', - ptext (sLit "addis"), -@@ -544,6 +554,8 @@ pprInstr (ADDIS reg1 reg2 imm) = hcat [ - pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3) - pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3) - pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3) -+pprInstr (SUBFC reg1 reg2 reg3) = pprLogic (sLit "subfc") reg1 reg2 (RIReg reg3) -+pprInstr (SUBFE reg1 reg2 reg3) = pprLogic (sLit "subfe") reg1 reg2 (RIReg reg3) - pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri - pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri - pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3) -Index: ghc-7.8.3/compiler/nativeGen/PPC/Regs.hs -=================================================================== ---- ghc-7.8.3.orig/compiler/nativeGen/PPC/Regs.hs -+++ ghc-7.8.3/compiler/nativeGen/PPC/Regs.hs -@@ -35,7 +35,8 @@ module PPC.Regs ( - fits16Bits, - makeImmediate, - fReg, -- sp, r3, r4, r27, r28, f1, f20, f21, -+ sp, r3, r4, r27, r28, r30, -+ f1, f20, f21, - - allocatableRegs - -@@ -293,12 +294,13 @@ point registers. - fReg :: Int -> RegNo - fReg x = (32 + x) - --sp, r3, r4, r27, r28, f1, f20, f21 :: Reg -+sp, r3, r4, r27, r28, r30, f1, f20, f21 :: Reg - sp = regSingle 1 - r3 = regSingle 3 - r4 = regSingle 4 - r27 = regSingle 27 - r28 = regSingle 28 -+r30 = regSingle 30 - f1 = regSingle $ fReg 1 - f20 = regSingle $ fReg 20 - f21 = regSingle $ fReg 21 -Index: ghc-7.8.3/includes/CodeGen.Platform.hs -=================================================================== ---- ghc-7.8.3.orig/includes/CodeGen.Platform.hs -+++ ghc-7.8.3/includes/CodeGen.Platform.hs -@@ -804,6 +804,8 @@ freeReg 1 = fastBool False -- The Stack - # if !MACHREGS_darwin - -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that - freeReg 2 = fastBool False -+-- at least linux in -fPIC relies on r30 in PLT stubs -+freeReg 30 = fastBool False - # endif - # ifdef REG_Base - freeReg REG_Base = fastBool False -Index: ghc-7.8.3/mk/config.mk.in -=================================================================== ---- ghc-7.8.3.orig/mk/config.mk.in -+++ ghc-7.8.3/mk/config.mk.in -@@ -95,7 +95,7 @@ TargetElf = YES - endif - - # Some platforms don't support shared libraries --NoSharedLibsPlatformList = powerpc-unknown-linux \ -+NoSharedLibsPlatformList = \ - x86_64-unknown-mingw32 \ - i386-unknown-mingw32 \ - sparc-sun-solaris2 \ diff --git a/_service b/_service deleted file mode 100644 index 96813c1..0000000 --- a/_service +++ /dev/null @@ -1,3 +0,0 @@ - - - diff --git a/ghc-7.10.2-src.tar.xz b/ghc-7.10.2-src.tar.xz new file mode 100644 index 0000000..9f19a50 --- /dev/null +++ b/ghc-7.10.2-src.tar.xz @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:54cd73755b784d78e2f13d5eb161bfa38d3efee9e8a56f7eb6cd9f2d6e2615f5 +size 11113204 diff --git a/ghc-7.8.2-cgen-constify.patch b/ghc-7.8.2-cgen-constify.patch deleted file mode 100644 index 86f53ab..0000000 --- a/ghc-7.8.2-cgen-constify.patch +++ /dev/null @@ -1,34 +0,0 @@ -commit b0cf3ab7a69b878a4335d21a347b56e4b0ca0b7b -Author: Sergei Trofimovich -Date: Mon Apr 14 19:06:24 2014 +0300 - - compiler/cmm/PprC.hs: constify local string literals - - Consider one-line module - module B (v) where v = "hello" - in -fvia-C mode it generates code like - static char gibberish_str[] = "hello"; - - It uselessly eats data section (precious resource on ia64!). - The patch switches genrator to emit: - static const char gibberish_str[] = "hello"; - - Signed-off-by: Sergei Trofimovich - -diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs -index 2398981..fdb578d 100644 ---- a/compiler/cmm/PprC.hs -+++ b/compiler/cmm/PprC.hs -@@ -112,6 +112,12 @@ pprTop (CmmProc infos clbl _ graph) = - - -- We only handle (a) arrays of word-sized things and (b) strings. - -+pprTop (CmmData ReadOnlyData (Statics lbl [CmmString str])) = -+ hcat [ -+ pprLocalness lbl, ptext (sLit "const char "), ppr lbl, -+ ptext (sLit "[] = "), pprStringInCStyle str, semi -+ ] -+ - pprTop (CmmData _section (Statics lbl [CmmString str])) = - hcat [ - pprLocalness lbl, ptext (sLit "char "), ppr lbl, diff --git a/ghc-7.8.4-src.tar.xz b/ghc-7.8.4-src.tar.xz deleted file mode 100644 index 74452f3..0000000 --- a/ghc-7.8.4-src.tar.xz +++ /dev/null @@ -1,3 +0,0 @@ -version https://git-lfs.github.com/spec/v1 -oid sha256:c319cd94adb284177ed0e6d21546ed0b900ad84b86b87c06a99eac35152982c4 -size 9128576 diff --git a/ghc-arm64.patch b/ghc-arm64.patch deleted file mode 100644 index 99188ee..0000000 --- a/ghc-arm64.patch +++ /dev/null @@ -1,322 +0,0 @@ -commit c29bf984dd20431cd4344e8a5c444d7a5be08389 -Author: Colin Watson -Date: Mon Apr 21 22:26:56 2014 -0500 -Bug: https://ghc.haskell.org/trac/ghc/ticket/7942 - - ghc: initial AArch64 patches - - Signed-off-by: Austin Seipp - -Index: ghc-7.8.4/aclocal.m4 -=================================================================== ---- ghc-7.8.4.orig/aclocal.m4 -+++ ghc-7.8.4/aclocal.m4 -@@ -200,6 +200,9 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_V - GET_ARM_ISA() - test -z "[$]2" || eval "[$]2=\"ArchARM {armISA = \$ARM_ISA, armISAExt = \$ARM_ISA_EXT, armABI = \$ARM_ABI}\"" - ;; -+ aarch64) -+ test -z "[$]2" || eval "[$]2=ArchARM64" -+ ;; - alpha) - test -z "[$]2" || eval "[$]2=ArchAlpha" - ;; -@@ -1865,6 +1868,9 @@ AC_MSG_CHECKING(for path to top of build - # converts cpu from gnu to ghc naming, and assigns the result to $target_var - AC_DEFUN([GHC_CONVERT_CPU],[ - case "$1" in -+ aarch64*) -+ $2="aarch64" -+ ;; - alpha*) - $2="alpha" - ;; -Index: ghc-7.8.4/compiler/nativeGen/AsmCodeGen.lhs -=================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/AsmCodeGen.lhs -+++ ghc-7.8.4/compiler/nativeGen/AsmCodeGen.lhs -@@ -166,6 +166,7 @@ nativeCodeGen dflags this_mod h us cmms - ArchPPC -> nCG' (ppcNcgImpl dflags) - ArchSPARC -> nCG' (sparcNcgImpl dflags) - ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" -+ ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64" - ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags) - ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" - ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" -Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs -=================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs -+++ ghc-7.8.4/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs -@@ -113,6 +113,7 @@ trivColorable platform virtualRegSqueeze - ArchSPARC -> 14 - ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" - ArchARM _ _ _ -> panic "trivColorable ArchARM" -+ ArchARM64 -> panic "trivColorable ArchARM64" - ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" - ArchMipsel -> panic "trivColorable ArchMipsel" -@@ -137,6 +138,7 @@ trivColorable platform virtualRegSqueeze - ArchSPARC -> 22 - ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" - ArchARM _ _ _ -> panic "trivColorable ArchARM" -+ ArchARM64 -> panic "trivColorable ArchARM64" - ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" - ArchMipsel -> panic "trivColorable ArchMipsel" -@@ -161,6 +163,7 @@ trivColorable platform virtualRegSqueeze - ArchSPARC -> 11 - ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" - ArchARM _ _ _ -> panic "trivColorable ArchARM" -+ ArchARM64 -> panic "trivColorable ArchARM64" - ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" - ArchMipsel -> panic "trivColorable ArchMipsel" -@@ -185,6 +188,7 @@ trivColorable platform virtualRegSqueeze - ArchSPARC -> 0 - ArchPPC_64 _ -> panic "trivColorable ArchPPC_64" - ArchARM _ _ _ -> panic "trivColorable ArchARM" -+ ArchARM64 -> panic "trivColorable ArchARM64" - ArchAlpha -> panic "trivColorable ArchAlpha" - ArchMipseb -> panic "trivColorable ArchMipseb" - ArchMipsel -> panic "trivColorable ArchMipsel" -Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs -=================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs -+++ ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs -@@ -74,6 +74,7 @@ maxSpillSlots dflags - ArchPPC -> PPC.Instr.maxSpillSlots dflags - ArchSPARC -> SPARC.Instr.maxSpillSlots dflags - ArchARM _ _ _ -> panic "maxSpillSlots ArchARM" -+ ArchARM64 -> panic "maxSpillSlots ArchARM64" - ArchPPC_64 _ -> PPC.Instr.maxSpillSlots dflags - ArchAlpha -> panic "maxSpillSlots ArchAlpha" - ArchMipseb -> panic "maxSpillSlots ArchMipseb" -Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/Main.hs -=================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/RegAlloc/Linear/Main.hs -+++ ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/Main.hs -@@ -207,6 +207,7 @@ linearRegAlloc dflags entry_ids block_li - ArchSPARC -> linearRegAlloc' dflags (frInitFreeRegs platform :: SPARC.FreeRegs) entry_ids block_live sccs - ArchPPC -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs) entry_ids block_live sccs - ArchARM _ _ _ -> panic "linearRegAlloc ArchARM" -+ ArchARM64 -> panic "linearRegAlloc ArchARM64" - ArchPPC_64 _ -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs) entry_ids block_live sccs - ArchAlpha -> panic "linearRegAlloc ArchAlpha" - ArchMipseb -> panic "linearRegAlloc ArchMipseb" -Index: ghc-7.8.4/compiler/nativeGen/TargetReg.hs -=================================================================== ---- ghc-7.8.4.orig/compiler/nativeGen/TargetReg.hs -+++ ghc-7.8.4/compiler/nativeGen/TargetReg.hs -@@ -54,6 +54,7 @@ targetVirtualRegSqueeze platform - ArchSPARC -> SPARC.virtualRegSqueeze - ArchPPC_64 _ -> PPC.virtualRegSqueeze - ArchARM _ _ _ -> panic "targetVirtualRegSqueeze ArchARM" -+ ArchARM64 -> panic "targetVirtualRegSqueeze ArchARM64" - ArchAlpha -> panic "targetVirtualRegSqueeze ArchAlpha" - ArchMipseb -> panic "targetVirtualRegSqueeze ArchMipseb" - ArchMipsel -> panic "targetVirtualRegSqueeze ArchMipsel" -@@ -70,6 +71,7 @@ targetRealRegSqueeze platform - ArchSPARC -> SPARC.realRegSqueeze - ArchPPC_64 _ -> PPC.realRegSqueeze - ArchARM _ _ _ -> panic "targetRealRegSqueeze ArchARM" -+ ArchARM64 -> panic "targetRealRegSqueeze ArchARM64" - ArchAlpha -> panic "targetRealRegSqueeze ArchAlpha" - ArchMipseb -> panic "targetRealRegSqueeze ArchMipseb" - ArchMipsel -> panic "targetRealRegSqueeze ArchMipsel" -@@ -85,6 +87,7 @@ targetClassOfRealReg platform - ArchSPARC -> SPARC.classOfRealReg - ArchPPC_64 _ -> PPC.classOfRealReg - ArchARM _ _ _ -> panic "targetClassOfRealReg ArchARM" -+ ArchARM64 -> panic "targetClassOfRealReg ArchARM64" - ArchAlpha -> panic "targetClassOfRealReg ArchAlpha" - ArchMipseb -> panic "targetClassOfRealReg ArchMipseb" - ArchMipsel -> panic "targetClassOfRealReg ArchMipsel" -@@ -100,6 +103,7 @@ targetMkVirtualReg platform - ArchSPARC -> SPARC.mkVirtualReg - ArchPPC_64 _ -> PPC.mkVirtualReg - ArchARM _ _ _ -> panic "targetMkVirtualReg ArchARM" -+ ArchARM64 -> panic "targetMkVirtualReg ArchARM64" - ArchAlpha -> panic "targetMkVirtualReg ArchAlpha" - ArchMipseb -> panic "targetMkVirtualReg ArchMipseb" - ArchMipsel -> panic "targetMkVirtualReg ArchMipsel" -@@ -115,6 +119,7 @@ targetRegDotColor platform - ArchSPARC -> SPARC.regDotColor - ArchPPC_64 _ -> PPC.regDotColor - ArchARM _ _ _ -> panic "targetRegDotColor ArchARM" -+ ArchARM64 -> panic "targetRegDotColor ArchARM64" - ArchAlpha -> panic "targetRegDotColor ArchAlpha" - ArchMipseb -> panic "targetRegDotColor ArchMipseb" - ArchMipsel -> panic "targetRegDotColor ArchMipsel" -Index: ghc-7.8.4/compiler/utils/Platform.hs -=================================================================== ---- ghc-7.8.4.orig/compiler/utils/Platform.hs -+++ ghc-7.8.4/compiler/utils/Platform.hs -@@ -55,6 +55,7 @@ data Arch - , armISAExt :: [ArmISAExt] - , armABI :: ArmABI - } -+ | ArchARM64 - | ArchAlpha - | ArchMipseb - | ArchMipsel -Index: ghc-7.8.4/includes/stg/HaskellMachRegs.h -=================================================================== ---- ghc-7.8.4.orig/includes/stg/HaskellMachRegs.h -+++ ghc-7.8.4/includes/stg/HaskellMachRegs.h -@@ -39,6 +39,7 @@ - || powerpc64le_TARGET_ARCH || rs6000_TARGET_ARCH) - #define MACHREGS_sparc sparc_TARGET_ARCH - #define MACHREGS_arm arm_TARGET_ARCH -+#define MACHREGS_aarch64 aarch64_TARGET_ARCH - #define MACHREGS_darwin darwin_TARGET_OS - - #endif -Index: ghc-7.8.4/includes/stg/MachRegs.h -=================================================================== ---- ghc-7.8.4.orig/includes/stg/MachRegs.h -+++ ghc-7.8.4/includes/stg/MachRegs.h -@@ -1,6 +1,6 @@ - /* ----------------------------------------------------------------------------- - * -- * (c) The GHC Team, 1998-2011 -+ * (c) The GHC Team, 1998-2014 - * - * Registers used in STG code. Might or might not correspond to - * actual machine registers. -@@ -531,6 +531,61 @@ - #define REG_D2 d11 - #endif - -+/* ----------------------------------------------------------------------------- -+ The ARMv8/AArch64 ABI register mapping -+ -+ The AArch64 provides 31 64-bit general purpose registers -+ and 32 128-bit SIMD/floating point registers. -+ -+ General purpose registers (see Chapter 5.1.1 in ARM IHI 0055B) -+ -+ Register | Special | Role in the procedure call standard -+ ---------+---------+------------------------------------ -+ SP | | The Stack Pointer -+ r30 | LR | The Link Register -+ r29 | FP | The Frame Pointer -+ r19-r28 | | Callee-saved registers -+ r18 | | The Platform Register, if needed; -+ | | or temporary register -+ r17 | IP1 | The second intra-procedure-call temporary register -+ r16 | IP0 | The first intra-procedure-call scratch register -+ r9-r15 | | Temporary registers -+ r8 | | Indirect result location register -+ r0-r7 | | Parameter/result registers -+ -+ -+ FPU/SIMD registers -+ -+ s/d/q/v0-v7 Argument / result/ scratch registers -+ s/d/q/v8-v15 callee-saved registers (must be preserved across subrutine calls, -+ but only bottom 64-bit value needs to be preserved) -+ s/d/q/v16-v31 temporary registers -+ -+ ----------------------------------------------------------------------------- */ -+ -+#elif MACHREGS_aarch64 -+ -+#define REG(x) __asm__(#x) -+ -+#define REG_Base r19 -+#define REG_Sp r20 -+#define REG_Hp r21 -+#define REG_R1 r22 -+#define REG_R2 r23 -+#define REG_R3 r24 -+#define REG_R4 r25 -+#define REG_R5 r26 -+#define REG_R6 r27 -+#define REG_SpLim r28 -+ -+#define REG_F1 s8 -+#define REG_F2 s9 -+#define REG_F3 s10 -+#define REG_F4 s11 -+ -+#define REG_D1 d12 -+#define REG_D2 d13 -+ - #else - - #error Cannot find platform to give register info for -Index: ghc-7.8.4/rts/StgCRun.c -=================================================================== ---- ghc-7.8.4.orig/rts/StgCRun.c -+++ ghc-7.8.4/rts/StgCRun.c -@@ -756,4 +756,70 @@ StgRun(StgFunPtr f, StgRegTable *basereg - } - #endif - -+#ifdef aarch64_HOST_ARCH -+ -+StgRegTable * -+StgRun(StgFunPtr f, StgRegTable *basereg) { -+ StgRegTable * r; -+ __asm__ volatile ( -+ /* -+ * save callee-saves registers on behalf of the STG code. -+ */ -+ "stp x19, x20, [sp, #-16]!\n\t" -+ "stp x21, x22, [sp, #-16]!\n\t" -+ "stp x23, x24, [sp, #-16]!\n\t" -+ "stp x25, x26, [sp, #-16]!\n\t" -+ "stp x27, x28, [sp, #-16]!\n\t" -+ "stp ip0, ip1, [sp, #-16]!\n\t" -+ "str lr, [sp, #-8]!\n\t" -+ -+ /* -+ * allocate some space for Stg machine's temporary storage. -+ * Note: RESERVER_C_STACK_BYTES has to be a round number here or -+ * the assembler can't assemble it. -+ */ -+ "str lr, [sp, %3]" -+ /* "sub sp, sp, %3\n\t" */ -+ /* -+ * Set BaseReg -+ */ -+ "mov x19, %2\n\t" -+ /* -+ * Jump to function argument. -+ */ -+ "bx %1\n\t" -+ -+ ".globl " STG_RETURN "\n\t" -+ ".type " STG_RETURN ", %%function\n" -+ STG_RETURN ":\n\t" -+ /* -+ * Free the space we allocated -+ */ -+ "ldr lr, [sp], %3\n\t" -+ /* "add sp, sp, %3\n\t" */ -+ /* -+ * Return the new register table, taking it from Stg's R1 (ARM64's R22). -+ */ -+ "mov %0, x22\n\t" -+ /* -+ * restore callee-saves registers. -+ */ -+ "ldr lr, [sp], #8\n\t" -+ "ldp ip0, ip1, [sp], #16\n\t" -+ "ldp x27, x28, [sp], #16\n\t" -+ "ldp x25, x26, [sp], #16\n\t" -+ "ldp x23, x24, [sp], #16\n\t" -+ "ldp x21, x22, [sp], #16\n\t" -+ "ldp x19, x20, [sp], #16\n\t" -+ -+ : "=r" (r) -+ : "r" (f), "r" (basereg), "i" (RESERVED_C_STACK_BYTES) -+ : "%x19", "%x20", "%x21", "%x22", "%x23", "%x24", "%x25", "%x26", "%x27", "%x28", -+ "%ip0", "%ip1", "%lr" -+ ); -+ return r; -+} -+ -+#endif -+ - #endif /* !USE_MINIINTERPRETER */ diff --git a/ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch b/ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch deleted file mode 100644 index 1ee0ff7..0000000 --- a/ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch +++ /dev/null @@ -1,31 +0,0 @@ -From 44cee4852282f63393d532aad59c5cd865ff3ed6 Mon Sep 17 00:00:00 2001 -From: Erik de Castro Lopo -Date: Wed, 1 Apr 2015 04:46:01 +0000 -Subject: [PATCH] mk/config.mk.in : Enable SMP and GHCi support for Aarch64. - ---- - mk/config.mk.in | 4 ++-- - 1 file changed, 2 insertions(+), 2 deletions(-) - -Index: ghc-7.8.4/mk/config.mk.in -=================================================================== ---- ghc-7.8.4.orig/mk/config.mk.in -+++ ghc-7.8.4/mk/config.mk.in -@@ -174,7 +174,7 @@ HaveLibDL = @HaveLibDL@ - - # ArchSupportsSMP should be set iff there is support for that arch in - # includes/stg/SMP.h --ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le arm))) -+ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le arm aarch64))) - - GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO)) - -@@ -182,7 +182,7 @@ GhcWithSMP := $(strip $(if $(filter YESN - # has support for this OS/ARCH combination. - - OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 cygwin32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu))) --ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm))) -+ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm aarch64))) - - ifeq "$(OsSupportsGHCi)$(ArchSupportsGHCi)" "YESYES" - GhcWithInterpreter=YES diff --git a/ghc-glibc-2.20_BSD_SOURCE.patch b/ghc-glibc-2.20_BSD_SOURCE.patch deleted file mode 100644 index f6cc9d5..0000000 --- a/ghc-glibc-2.20_BSD_SOURCE.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 7d738547049e686be4d90a19dcb9520418d5f72d Mon Sep 17 00:00:00 2001 -From: Jens Petersen -Date: Mon, 9 Jun 2014 15:48:41 +0900 -Subject: [PATCH] define _DEFAULT_SOURCE in Stg.h to avoid warnings from glibc - 2.20 (#9185) - ---- - includes/Stg.h | 2 ++ - 1 file changed, 2 insertions(+) - -diff --git a/includes/Stg.h b/includes/Stg.h -index 1707c9b..fbcf643 100644 ---- a/includes/Stg.h -+++ b/includes/Stg.h -@@ -47,6 +47,8 @@ - // We need _BSD_SOURCE so that math.h defines things like gamma - // on Linux - # define _BSD_SOURCE -+// glibc 2.20 deprecates _BSD_SOURCE in favour of _DEFAULT_SOURCE -+# define _DEFAULT_SOURCE - #endif - - #if IN_STG_CODE == 0 || defined(llvm_CC_FLAVOR) --- -1.9.3 - diff --git a/ghc.changes b/ghc.changes index 2f1377e..33edec7 100644 --- a/ghc.changes +++ b/ghc.changes @@ -1,3 +1,39 @@ +------------------------------------------------------------------- +Mon Aug 10 17:38:34 UTC 2015 - peter.trommler@ohm-hochschule.de + +- update to 7.10.2 +* type checker fixes +* fixes for Aarch64 support +* fix deadlock in runtime system when scheduling garbage collection +- 7.10.1 highlights +* implement Applicative Monad Proposal +* implement Burning Bridges Proposal +* support for partial type signatures +* reimplement integer-gmp +* support plugins in type checker (experimental!) +- drop llvm-powerpc64-datalayout.patch +* this patch was incomplete all along and now we have our native + code generator +- drop ghc-cabal-unversion-docdir.patch +* ghc-rpm-macros is following ghc's doc layout so no need to patch +- drop D349.patch +* fixed upstream +- drop integer-gmp.patch +* we do not support SLE11 anymore +- drop ghc-7.8.2-cgen-constify.patch +* fixed upstream +- drop D560.patch +* fixed upstream +- drop ghc-glibc-2.20_BSD_SOURCE.patch +* fixed upstream +- drop ghc-arm64.patch +* fixed upstream +- drop ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch +* fixed upstream +- refresh 0001-implement-native-code-generator-for-ppc64.patch +- disable ghc-7.8-arm-use-ld-gold.patch +* not sure we need this, must be rebased if we do + ------------------------------------------------------------------- Fri Jul 17 14:58:44 UTC 2015 - peter.trommler@ohm-hochschule.de diff --git a/ghc.spec b/ghc.spec index 3912b6d..27414a3 100644 --- a/ghc.spec +++ b/ghc.spec @@ -19,7 +19,7 @@ %global unregisterised_archs aarch64 s390 s390x Name: ghc -Version: 7.8.4 +Version: 7.10.2 Release: 0 Url: http://haskell.org/ghc/dist/%{version}/%{name}-%{version}-src.tar.bz2 Summary: The Glorious Glasgow Haskell Compiler @@ -28,7 +28,7 @@ Group: Development/Languages/Other ExclusiveArch: aarch64 %{ix86} x86_64 ppc ppc64 ppc64le s390 s390x BuildRequires: binutils-devel BuildRequires: gcc -BuildRequires: ghc-bootstrap >= 7.4 +BuildRequires: ghc-bootstrap >= 7.6 BuildRequires: ghc-rpm-macros-extra BuildRequires: glibc-devel BuildRequires: gmp-devel @@ -59,24 +59,8 @@ 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 llvm-powerpc64-datalayout.patch peter.trommler@ohm-hochschule.de - Add target datalayout for llvm on powerpc 64. -Patch8: llvm-powerpc64-datalayout.patch -# PATCH-FIX-UPSTREAM D349.patch peter.trommler@ohm-hochschule.de - Fix dynamic linker, see Haskell trac #8935. -Patch12: D349.patch -# PATCH-FIX-UPSTREAM integer-gmp.patch peter.trommler@ohm-hochschule.de -- Fix upstream ticket #8156 see https://ghc.haskell.org/trac/ghc/ticket/8156. We need this for SLE 11 where libgmp is too old and so we have to use the bundled libgmp. This patch fixes the build. -Patch13: integer-gmp.patch -# PATCH-FIX-UPSTREAM ghc-7.8.2-cgen-constify.patch peter.trommler@ohm-hochschule.de - Make constant strings constant in C backend to save data segment space. This is a gentoo patch. -Patch14: ghc-7.8.2-cgen-constify.patch -# PATCH-FIX-UPSTREAM D560.patch peter.trommler@ohm-hochschule.de -- Fix loading of PIC register. See https://phabricator.haskell.org/D560. -Patch18: D560.patch # PATCH-FEATURE-UPSTREAM 0001-implement-native-code-generator-for-ppc64.patch peter.trommler@ohm-hochschule.de -- Implement native code generator for ppc64. Haskell Trac #9863. Patch19: 0001-implement-native-code-generator-for-ppc64.patch -# PATCH-FIX-UPSTREAM ghc-glibc-2.20_BSD_SOURCE.patch peter.trommler@ohm-hochschule.de -- Define _DEFAULT_SOURCE in Stg.h to avoid warnings from glibc. Fedora patch -Patch20: ghc-glibc-2.20_BSD_SOURCE.patch -# PATCH-FIX-OPENSUSE add aarch64 support -Patch21: ghc-arm64.patch -# PATCH-FIX-UPSTREAM ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch peter.trommler@ohm-hochschule.de -- Provide SMP implementation and enable GHCi on aarch64. Adapted from Fedora patch 26. -Patch22: ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch # PATCH-FIX-UPSTREAM peter.trommler@ohm-hochschule.de -- GNU ld does not work with ghc on aarch64 so use Gold. Adapted from Fedora patch 24. Patch23: ghc-7.8-arm-use-ld-gold.patch @@ -125,32 +109,28 @@ To install all of GHC install package ghc. %global ghc_pkg_c_deps ghc-compiler = %{ghc_version_override}-%{release} %if %{defined ghclibdir} -%ghc_lib_subpackage Cabal 1.18.1.5 -%ghc_lib_subpackage array 0.5.0.0 -%ghc_lib_subpackage -c gmp-devel,libffi-devel base 4.7.0.2 -%ghc_lib_subpackage binary 0.7.1.0 -%ghc_lib_subpackage bytestring 0.10.4.0 -%ghc_lib_subpackage containers 0.5.5.1 -%ghc_lib_subpackage deepseq 1.3.0.2 -%ghc_lib_subpackage directory 1.2.1.0 -%ghc_lib_subpackage filepath 1.3.0.2 +%ghc_lib_subpackage Cabal 1.22.4.0 +%ghc_lib_subpackage array 0.5.1.0 +%ghc_lib_subpackage -c gmp-devel,libffi-devel base 4.8.1.0 +%ghc_lib_subpackage binary 0.7.5.0 +%ghc_lib_subpackage bytestring 0.10.6.0 +%ghc_lib_subpackage containers 0.5.6.2 +%ghc_lib_subpackage deepseq 1.4.1.1 +%ghc_lib_subpackage directory 1.2.2.0 +%ghc_lib_subpackage filepath 1.4.0.0 %define ghc_pkg_obsoletes ghc-bin-package-db-devel < 0.0.0.0-%{release} %ghc_lib_subpackage -x ghc %{ghc_version_override} %undefine ghc_pkg_obsoletes -%ghc_lib_subpackage haskeline 0.7.1.2 -%ghc_lib_subpackage haskell2010 1.1.2.0 -%ghc_lib_subpackage haskell98 2.0.0.3 -%ghc_lib_subpackage hoopl 3.10.0.1 -%ghc_lib_subpackage hpc 0.6.0.1 -%ghc_lib_subpackage old-locale 1.0.0.6 -%ghc_lib_subpackage old-time 1.1.0.2 -%ghc_lib_subpackage pretty 1.1.1.1 -%ghc_lib_subpackage process 1.2.0.0 -%ghc_lib_subpackage template-haskell 2.9.0.0 -%ghc_lib_subpackage terminfo 0.4.0.0 -%ghc_lib_subpackage time 1.4.2 -%ghc_lib_subpackage transformers 0.3.0.0 -%ghc_lib_subpackage unix 2.7.0.1 +%ghc_lib_subpackage haskeline 0.7.2.1 +%ghc_lib_subpackage hoopl 3.10.0.2 +%ghc_lib_subpackage hpc 0.6.0.2 +%ghc_lib_subpackage pretty 1.1.2.0 +%ghc_lib_subpackage process 1.2.3.0 +%ghc_lib_subpackage template-haskell 2.10.0.0 +%ghc_lib_subpackage terminfo 0.4.0.1 +%ghc_lib_subpackage time 1.5.0.1 +%ghc_lib_subpackage transformers 0.4.2.0 +%ghc_lib_subpackage unix 2.7.1.0 %ghc_lib_subpackage xhtml 3000.2.1 %endif @@ -172,21 +152,11 @@ except the ghc library, which is installed by the toplevel ghc metapackage. %prep %setup -q -%patch8 -p1 -%patch12 -p1 -%patch13 -p1 -%patch14 -p1 -%patch18 -p1 %patch19 -p1 -%patch20 -p1 -%patch21 -p1 -%ifarch aarch64 -%patch22 -p1 -b .orig -%endif -%ifarch armv7hl aarch64 -%patch23 -p1 -b .24~ -%endif +#%%ifarch armv7hl aarch64 +#%%patch23 -p1 -b .24~ +#%%endif %build # Patch 19 and 22 modify build system @@ -296,8 +266,8 @@ echo "%dir %{ghclibdir}" >> ghc-base.files %ghc_gen_filelists bin-package-db 0.0.0.0 %ghc_gen_filelists ghc %{ghc_version_override} -%ghc_gen_filelists ghc-prim 0.3.1.0 -%ghc_gen_filelists integer-gmp 0.5.1.0 +%ghc_gen_filelists ghc-prim 0.4.0.0 +%ghc_gen_filelists integer-gmp 1.0.0.0 %define merge_filelist()\ cat ghc-%1.files >> ghc-%2.files\ @@ -310,12 +280,12 @@ echo "%doc libraries/LICENSE.%1" >> ghc-%2.files %merge_filelist bin-package-db ghc %if %{undefined ghc_without_shared} -echo %%dir %{ghclibdir}/rts-1.0 >> ghc-base.files -ls %{buildroot}%{ghclibdir}/rts-1.0/libHS*.so >> ghc-base.files +echo %%dir %{ghclibdir}/rts >> ghc-base.files +ls %{buildroot}%{ghclibdir}/rts/libHS*.so >> ghc-base.files sed -i -e "s|^%{buildroot}||g" ghc-base.files %endif -echo %%dir %{ghclibdir}/rts-1.0 >> ghc-base-devel.files -ls -d %{buildroot}%{ghclibdir}/rts-1.0/libHS*.a %{buildroot}%{ghclibdir}/package.conf.d/builtin_*.conf %{buildroot}%{ghclibdir}/include >> ghc-base-devel.files +echo %%dir %{ghclibdir}/rts >> ghc-base-devel.files +ls -d %{buildroot}%{ghclibdir}/rts/libHS*.a %{buildroot}%{ghclibdir}/package.conf.d/builtin_*.conf %{buildroot}%{ghclibdir}/include >> ghc-base-devel.files sed -i -e "s|^%{buildroot}||g" ghc-base-devel.files # these are handled as alternatives @@ -411,7 +381,6 @@ fi %endif %{ghclibdir}/ghc-usage.txt %{ghclibdir}/ghci-usage.txt -%{ghclibdir}/mkGmpDerivedConstants %dir %{ghclibdir}/package.conf.d %ghost %{ghclibdir}/package.conf.d/package.cache %{ghclibdir}/platformConstants diff --git a/integer-gmp.patch b/integer-gmp.patch deleted file mode 100644 index b494b58..0000000 --- a/integer-gmp.patch +++ /dev/null @@ -1,26 +0,0 @@ -Index: ghc-7.8.3/libraries/integer-gmp/gmp/ghc.mk -=================================================================== ---- ghc-7.8.3.orig/libraries/integer-gmp/gmp/ghc.mk -+++ ghc-7.8.3/libraries/integer-gmp/gmp/ghc.mk -@@ -66,6 +66,12 @@ else - BUILD_SHARED=no - endif - -+ifeq "$(firstword $(subst -, ,$(HOSTPLATFORM)))" "x86_64" -+ FORCE_PIC=--with-pic=yes -+else -+ FORCE_PIC= -+endif -+ - # In a bindist, we don't want to know whether /this/ machine has gmp, - # but whether the machine the bindist was built on had gmp. - ifeq "$(BINDIST)" "YES" -@@ -147,7 +153,7 @@ libraries/integer-gmp/gmp/libgmp.a libra - export PATH; \ - cd gmpbuild && \ - CC=$(CCX) NM=$(NM) AR=$(AR_STAGE1) ./configure \ -- --enable-shared=no \ -+ --enable-shared=no $(FORCE_PIC) \ - --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM) - $(MAKE) -C libraries/integer-gmp/gmp/gmpbuild MAKEFLAGS= - $(CP) libraries/integer-gmp/gmp/gmpbuild/gmp.h libraries/integer-gmp/gmp/ diff --git a/llvm-powerpc64-datalayout.patch b/llvm-powerpc64-datalayout.patch deleted file mode 100644 index 6866c4f..0000000 --- a/llvm-powerpc64-datalayout.patch +++ /dev/null @@ -1,14 +0,0 @@ -Index: ghc-7.8.2/compiler/llvmGen/LlvmCodeGen/Ppr.hs -=================================================================== ---- ghc-7.8.2.orig/compiler/llvmGen/LlvmCodeGen/Ppr.hs -+++ ghc-7.8.2/compiler/llvmGen/LlvmCodeGen/Ppr.hs -@@ -64,6 +64,9 @@ moduleLayout = sdocWithPlatform $ \platf - Platform { platformArch = ArchX86, platformOS = OSiOS } -> - text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128-n8:16:32\"" - $+$ text "target triple = \"i386-apple-darwin11\"" -+ Platform { platformArch = ArchPPC_64 , platformOS = OSLinux } -> -+ text "target datalayout = \"E-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v128:128:128-n32:64\"" -+ $+$ text "target triple = \"powerpc64-unknown-linux-gnu\"" - _ -> - -- FIX: Other targets - empty