From 97906cfcc30dd591e840921d336fdabeb1b8a315 Mon Sep 17 00:00:00 2001 From: wolfgang Date: Sat, 12 Oct 2002 23:28:51 +0000 Subject: [PATCH] [project @ 2002-10-12 23:28:48 by wolfgang] The Native Code Generator for PowerPC. Still to be done: *) Proper support of Floats and Doubles currently it seems to work, but it's just guesswork. *) Some missing operations, only needed for -O, AFAICT. *) Mach-O dynamic linker stub generation. (can't import foreign functions from dynamic libraries, and it might fail for big programs) --- ghc/compiler/nativeGen/MachCode.lhs | 745 ++++++++++++++++++++++++++++++- ghc/compiler/nativeGen/MachMisc.lhs | 121 ++++- ghc/compiler/nativeGen/MachRegs.lhs | 173 ++++++- ghc/compiler/nativeGen/NCG.h | 17 + ghc/compiler/nativeGen/PprMach.lhs | 318 ++++++++++++- ghc/compiler/nativeGen/RegAllocInfo.lhs | 116 ++++- 6 files changed, 1445 insertions(+), 45 deletions(-) diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 1126080..1910ef1 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -29,6 +29,9 @@ import CLabel ( isAsmTemp ) #endif import Maybes ( maybeToBool ) import PrimRep ( isFloatingRep, is64BitRep, PrimRep(..), +#if powerpc_TARGET_ARCH + getPrimRepSize, +#endif getPrimRepSizeInBytes ) import Stix ( getNatLabelNCG, StixStmt(..), StixExpr(..), StixReg(..), pprStixReg, StixVReg(..), CodeSegment(..), @@ -433,6 +436,94 @@ iselExpr64 expr = pprPanic "iselExpr64(sparc)" (pprStixExpr expr) #endif {- sparc_TARGET_ARCH -} +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +#if powerpc_TARGET_ARCH + +assignMem_I64Code addrTree valueTree + = iselExpr64 valueTree `thenNat` \ (ChildCode64 vcode vrlo) -> + getRegister addrTree `thenNat` \ register_addr -> + getNewRegNCG IntRep `thenNat` \ t_addr -> + let rlo = VirtualRegI vrlo + rhi = getHiVRegFromLo rlo + code_addr = registerCode register_addr t_addr + reg_addr = registerName register_addr t_addr + -- Big-endian store + mov_hi = ST W rhi (AddrRegImm reg_addr (ImmInt 0)) + mov_lo = ST W rlo (AddrRegImm reg_addr (ImmInt 4)) + in + returnNat (vcode `appOL` code_addr `snocOL` mov_hi `snocOL` mov_lo) + + +assignReg_I64Code (StixTemp (StixVReg u_dst pk)) valueTree + = iselExpr64 valueTree `thenNat` \ (ChildCode64 vcode vr_src_lo) -> + let + r_dst_lo = mkVReg u_dst IntRep + r_src_lo = VirtualRegI vr_src_lo + r_dst_hi = getHiVRegFromLo r_dst_lo + r_src_hi = getHiVRegFromLo r_src_lo + mov_lo = MR r_dst_lo r_src_lo + mov_hi = MR r_dst_hi r_src_hi + in + returnNat ( + vcode `snocOL` mov_hi `snocOL` mov_lo + ) +assignReg_I64Code lvalue valueTree + = pprPanic "assignReg_I64Code(powerpc): invalid lvalue" + (pprStixReg lvalue) + + +-- Don't delete this -- it's very handy for debugging. +--iselExpr64 expr +-- | trace ("iselExpr64: " ++ showSDoc (pprStixExpr expr)) False +-- = panic "iselExpr64(???)" + +iselExpr64 (StInd pk addrTree) + | is64BitRep pk + = getRegister addrTree `thenNat` \ register_addr -> + getNewRegNCG IntRep `thenNat` \ t_addr -> + getNewRegNCG IntRep `thenNat` \ rlo -> + let rhi = getHiVRegFromLo rlo + code_addr = registerCode register_addr t_addr + reg_addr = registerName register_addr t_addr + mov_hi = LD W rhi (AddrRegImm reg_addr (ImmInt 0)) + mov_lo = LD W rlo (AddrRegImm reg_addr (ImmInt 4)) + in + returnNat ( + ChildCode64 (code_addr `snocOL` mov_hi `snocOL` mov_lo) + (getVRegUnique rlo) + ) + +iselExpr64 (StReg (StixTemp (StixVReg vu pk))) + | is64BitRep pk + = getNewRegNCG IntRep `thenNat` \ r_dst_lo -> + let r_dst_hi = getHiVRegFromLo r_dst_lo + r_src_lo = mkVReg vu IntRep + r_src_hi = getHiVRegFromLo r_src_lo + mov_lo = MR r_dst_lo r_src_lo + mov_hi = MR r_dst_hi r_src_hi + in + returnNat ( + ChildCode64 (toOL [mov_hi, mov_lo]) (getVRegUnique r_dst_lo) + ) + +iselExpr64 (StCall fn cconv kind args) + | is64BitRep kind + = genCCall fn cconv kind args `thenNat` \ call -> + getNewRegNCG IntRep `thenNat` \ r_dst_lo -> + let r_dst_hi = getHiVRegFromLo r_dst_lo + mov_lo = MR r_dst_lo r3 + mov_hi = MR r_dst_hi r4 + in + returnNat ( + ChildCode64 (call `snocOL` mov_hi `snocOL` mov_lo) + (getVRegUnique r_dst_lo) + ) + +iselExpr64 expr + = pprPanic "iselExpr64(powerpc)" (pprStixExpr expr) + +#endif {- powerpc_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -533,8 +624,8 @@ getRegister (StCall fn cconv kind args) returnNat (Fixed kind reg call) where reg = if isFloatingRep kind - then IF_ARCH_alpha( f0, IF_ARCH_i386( fake0, IF_ARCH_sparc( f0,))) - else IF_ARCH_alpha( v0, IF_ARCH_i386( eax, IF_ARCH_sparc( o0,))) + then IF_ARCH_alpha( f0, IF_ARCH_i386( fake0, IF_ARCH_sparc( f0, IF_ARCH_powerpc( f1,)))) + else IF_ARCH_alpha( v0, IF_ARCH_i386( eax, IF_ARCH_sparc( o0, IF_ARCH_powerpc( r3,)))) getRegister (StString s) = getNatLabelNCG `thenNat` \ lbl -> @@ -556,6 +647,10 @@ getRegister (StString s) SETHI (HI imm_lbl) dst, OR False dst (RIImm (LO imm_lbl)) dst #endif +#if powerpc_TARGET_ARCH + LIS dst (HI imm_lbl), + OR dst dst (RIImm (LO imm_lbl)) +#endif ] in returnNat (Any PtrRep code) @@ -1465,6 +1560,195 @@ getRegister leaf #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH +getRegister (StMachOp mop [x]) -- unary MachOps + = case mop of + MO_NatS_Neg -> trivialUCode NEG x + MO_Nat_Not -> trivialUCode NOT x + -- MO_32U_to_8U -> trivialUCode (AND (RIImm (ImmInt 255))) x + MO_32U_to_8U -> trivialCode AND x (StInt 255) + + MO_Flt_to_NatS -> coerceFP2Int FloatRep x + MO_NatS_to_Flt -> coerceInt2FP FloatRep x + MO_Dbl_to_NatS -> coerceFP2Int DoubleRep x + MO_NatS_to_Dbl -> coerceInt2FP DoubleRep x + + -- Conversions which are a nop on x86 + MO_NatS_to_32U -> conversionNop WordRep x + MO_32U_to_NatS -> conversionNop IntRep x + MO_32U_to_NatU -> conversionNop WordRep x + + MO_NatU_to_NatS -> conversionNop IntRep x + MO_NatS_to_NatU -> conversionNop WordRep x + MO_NatP_to_NatU -> conversionNop WordRep x + MO_NatU_to_NatP -> conversionNop PtrRep x + MO_NatS_to_NatP -> conversionNop PtrRep x + MO_NatP_to_NatS -> conversionNop IntRep x + + MO_Dbl_to_Flt -> conversionNop FloatRep x + MO_Flt_to_Dbl -> conversionNop DoubleRep x + + -- sign-extending widenings ###PPC This is inefficient: use ext* instructions + MO_8U_to_NatU -> integerExtend False 24 x + MO_8S_to_NatS -> integerExtend True 24 x + MO_16U_to_NatU -> integerExtend False 16 x + MO_16S_to_NatS -> integerExtend True 16 x + MO_8U_to_32U -> integerExtend False 24 x + + other -> pprPanic "getRegister(powerpc) - unary StMachOp" + (pprMachOp mop) + where + integerExtend signed nBits x + = getRegister ( + StMachOp (if signed then MO_Nat_Sar else MO_Nat_Shr) + [StMachOp MO_Nat_Shl [x, StInt nBits], StInt nBits] + ) + conversionNop new_rep expr + = getRegister expr `thenNat` \ e_code -> + returnNat (swizzleRegisterRep e_code new_rep) + +getRegister (StMachOp mop [x, y]) -- dyadic PrimOps + = case mop of + MO_32U_Gt -> condIntReg GTT x y + MO_32U_Ge -> condIntReg GE x y + MO_32U_Eq -> condIntReg EQQ x y + MO_32U_Ne -> condIntReg NE x y + MO_32U_Lt -> condIntReg LTT x y + MO_32U_Le -> condIntReg LE x y + + MO_Nat_Eq -> condIntReg EQQ x y + MO_Nat_Ne -> condIntReg NE x y + + MO_NatS_Gt -> condIntReg GTT x y + MO_NatS_Ge -> condIntReg GE x y + MO_NatS_Lt -> condIntReg LTT x y + MO_NatS_Le -> condIntReg LE x y + + MO_NatU_Gt -> condIntReg GU x y + MO_NatU_Ge -> condIntReg GEU x y + MO_NatU_Lt -> condIntReg LU x y + MO_NatU_Le -> condIntReg LEU x y + + MO_Flt_Gt -> condFltReg GTT x y + MO_Flt_Ge -> condFltReg GE x y + MO_Flt_Eq -> condFltReg EQQ x y + MO_Flt_Ne -> condFltReg NE x y + MO_Flt_Lt -> condFltReg LTT x y + MO_Flt_Le -> condFltReg LE x y + + MO_Dbl_Gt -> condFltReg GTT x y + MO_Dbl_Ge -> condFltReg GE x y + MO_Dbl_Eq -> condFltReg EQQ x y + MO_Dbl_Ne -> condFltReg NE x y + MO_Dbl_Lt -> condFltReg LTT x y + MO_Dbl_Le -> condFltReg LE x y + + MO_Nat_Add -> trivialCode ADD x y + MO_Nat_Sub -> trivialCode SUBF y x + + MO_NatS_Mul -> trivialCode MULLW x y + MO_NatU_Mul -> trivialCode MULLW x y + + MO_NatS_Quot -> trivialCode2 DIVW x y + MO_NatU_Quot -> trivialCode2 DIVWU x y + + MO_Nat_And -> trivialCode AND x y + MO_Nat_Or -> trivialCode OR x y + MO_Nat_Xor -> trivialCode XOR x y + + MO_Nat_Shl -> trivialCode SLW x y + MO_Nat_Shr -> trivialCode SRW x y + MO_Nat_Sar -> trivialCode SRAW x y + + {- MO_NatS_Mul -> trivialCode (SMUL False) x y + MO_NatU_Mul -> trivialCode (UMUL False) x y + MO_NatS_MulMayOflo -> imulMayOflo x y + imulMayOflo + -- ToDo: teach about V8+ SPARC div instructions + MO_NatS_Quot -> idiv FSLIT(".div") x y + MO_NatS_Rem -> idiv FSLIT(".rem") x y + MO_NatU_Quot -> idiv FSLIT(".udiv") x y + MO_NatU_Rem -> idiv FSLIT(".urem") x y -} + + MO_Flt_Add -> trivialFCode FloatRep FADD x y + MO_Flt_Sub -> trivialFCode FloatRep FSUB x y + MO_Flt_Mul -> trivialFCode FloatRep FMUL x y + MO_Flt_Div -> trivialFCode FloatRep FDIV x y + + MO_Dbl_Add -> trivialFCode DoubleRep FADD x y + MO_Dbl_Sub -> trivialFCode DoubleRep FSUB x y + MO_Dbl_Mul -> trivialFCode DoubleRep FMUL x y + MO_Dbl_Div -> trivialFCode DoubleRep FDIV x y +{- + MO_Flt_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv DoubleRep + [promote x, promote y]) + where promote x = StMachOp MO_Flt_to_Dbl [x] + MO_Dbl_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv DoubleRep + [x, y]) + -} + other -> pprPanic "getRegister(powerpc) - binary StMachOp (1)" (pprMachOp mop) + +getRegister (StInd pk mem) + = getAmode mem `thenNat` \ amode -> + let + code = amodeCode amode + src = amodeAddr amode + size = primRepToSize pk + code__2 dst = code `snocOL` LD size dst src + in + returnNat (Any pk code__2) + +getRegister (StInt i) + | fits16Bits i + = let + src = ImmInt (fromInteger i) + code dst = unitOL (LI dst src) + in + returnNat (Any IntRep code) + +getRegister (StFloat d) + = getNatLabelNCG `thenNat` \ lbl -> + getNewRegNCG PtrRep `thenNat` \ tmp -> + let code dst = toOL [ + SEGMENT RoDataSegment, + LABEL lbl, + DATA F [ImmFloat d], + SEGMENT TextSegment, + LIS tmp (HA (ImmCLbl lbl)), + LD F dst (AddrRegImm tmp (LO (ImmCLbl lbl)))] + in + returnNat (Any FloatRep code) + +getRegister (StDouble d) + = getNatLabelNCG `thenNat` \ lbl -> + getNewRegNCG PtrRep `thenNat` \ tmp -> + let code dst = toOL [ + SEGMENT RoDataSegment, + LABEL lbl, + DATA DF [ImmDouble d], + SEGMENT TextSegment, + LIS tmp (HA (ImmCLbl lbl)), + LD DF dst (AddrRegImm tmp (LO (ImmCLbl lbl)))] + in + returnNat (Any DoubleRep code) + +getRegister leaf + | maybeToBool imm + = let + code dst = toOL [ + LIS dst (HI imm__2), + OR dst dst (RIImm (LO imm__2))] + in + returnNat (Any PtrRep code) + | otherwise + = ncgPrimopMoan "getRegister(powerpc)" (pprStixExpr leaf) + where + imm = maybeImm leaf + imm__2 = case imm of Just x -> x +#endif {- powerpc_TARGET_ARCH -} + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -1678,6 +1962,52 @@ getAmode other #endif {- sparc_TARGET_ARCH -} +#ifdef powerpc_TARGET_ARCH +getAmode (StMachOp MO_Nat_Sub [x, StInt i]) + | fits16Bits (-i) + = getNewRegNCG PtrRep `thenNat` \ tmp -> + getRegister x `thenNat` \ register -> + let + code = registerCode register tmp + reg = registerName register tmp + off = ImmInt (-(fromInteger i)) + in + returnNat (Amode (AddrRegImm reg off) code) + + +getAmode (StMachOp MO_Nat_Add [x, StInt i]) + | fits16Bits i + = getNewRegNCG PtrRep `thenNat` \ tmp -> + getRegister x `thenNat` \ register -> + let + code = registerCode register tmp + reg = registerName register tmp + off = ImmInt (fromInteger i) + in + returnNat (Amode (AddrRegImm reg off) code) + +getAmode leaf + | maybeToBool imm + = getNewRegNCG PtrRep `thenNat` \ tmp -> + let + code = unitOL (LIS tmp (HA imm__2)) + in + returnNat (Amode (AddrRegImm tmp (LO imm__2)) code) + where + imm = maybeImm leaf + imm__2 = case imm of Just x -> x + +getAmode other + = getNewRegNCG PtrRep `thenNat` \ tmp -> + getRegister other `thenNat` \ register -> + let + code = registerCode register tmp + reg = registerName register tmp + off = ImmInt 0 + in + returnNat (Amode (AddrRegImm reg off) code) +#endif {- powerpc_TARGET_ARCH -} + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -1709,7 +2039,7 @@ getCondCode = panic "MachCode.getCondCode: not on Alphas" -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if i386_TARGET_ARCH || sparc_TARGET_ARCH +#if i386_TARGET_ARCH || sparc_TARGET_ARCH || powerpc_TARGET_ARCH -- yes, they really do seem to want exactly the same! getCondCode (StMachOp mop [x, y]) @@ -1748,11 +2078,12 @@ getCondCode (StMachOp mop [x, y]) MO_Dbl_Lt -> condFltCode LTT x y MO_Dbl_Le -> condFltCode LE x y - other -> pprPanic "getCondCode(x86,sparc)" (pprMachOp mop) + other -> pprPanic "getCondCode(x86,sparc,powerpc)" (pprMachOp mop) + +getCondCode other = pprPanic "getCondCode(2)(x86,sparc,powerpc)" (pprStixExpr other) -getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (pprStixExpr other) +#endif {- i386_TARGET_ARCH || sparc_TARGET_ARCH || powerpc_TARGET_ARCH -} -#endif {- i386_TARGET_ARCH || sparc_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -1982,6 +2313,56 @@ condFltCode cond x y #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH + +condIntCode cond x (StInt y) + | fits16Bits y + = getRegister x `thenNat` \ register -> + getNewRegNCG IntRep `thenNat` \ tmp -> + let + code = registerCode register tmp + src1 = registerName register tmp + src2 = ImmInt (fromInteger y) + code__2 = code `snocOL` + (if condUnsigned cond then CMPL else CMP) W src1 (RIImm src2) + in + returnNat (CondCode False cond code__2) + +condIntCode cond x y + = getRegister x `thenNat` \ register1 -> + getRegister y `thenNat` \ register2 -> + getNewRegNCG IntRep `thenNat` \ tmp1 -> + getNewRegNCG IntRep `thenNat` \ tmp2 -> + let + code1 = registerCode register1 tmp1 + src1 = registerName register1 tmp1 + code2 = registerCode register2 tmp2 + src2 = registerName register2 tmp2 + code__2 = code1 `appOL` code2 `snocOL` + (if condUnsigned cond then CMPL else CMP) W src1 (RIReg src2) + in + returnNat (CondCode False cond code__2) + +condFltCode cond x y + = getRegister x `thenNat` \ register1 -> + getRegister y `thenNat` \ register2 -> + getNewRegNCG (registerRep register1) + `thenNat` \ tmp1 -> + getNewRegNCG (registerRep register2) + `thenNat` \ tmp2 -> + let + code1 = registerCode register1 tmp1 + src1 = registerName register1 tmp1 + code2 = registerCode register2 tmp2 + src2 = registerName register2 tmp2 + code__2 = code1 `appOL` code2 `snocOL` + FCMP src1 src2 + in + returnNat (CondCode False cond code__2) + +#endif {- powerpc_TARGET_ARCH -} + + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -2116,10 +2497,7 @@ assignReg_IntCode pk reg src getRegister src `thenNat` \ registers -> getNewRegNCG IntRep `thenNat` \ tmp -> let - r_dst = registerName registerd tmp - r_src = registerName registers r_dst - c_src = registerCode registers r_dst - + code = c_src `snocOL` MOV L (OpReg r_src) (OpReg r_dst) in @@ -2148,8 +2526,9 @@ assignMem_IntCode pk addr src assignReg_IntCode pk reg src = getRegister src `thenNat` \ register2 -> getRegisterReg reg `thenNat` \ register1 -> + getNewRegNCG IntRep `thenNat` \ tmp -> let - dst__2 = registerName register1 g0 + dst__2 = registerName register1 tmp code = registerCode register2 dst__2 src__2 = registerName register2 dst__2 code__2 = if isFixed register2 @@ -2160,6 +2539,37 @@ assignReg_IntCode pk reg src #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH + +assignMem_IntCode pk addr src + = getNewRegNCG IntRep `thenNat` \ tmp -> + getAmode addr `thenNat` \ amode -> + getRegister src `thenNat` \ register -> + let + code1 = amodeCode amode + dst__2 = amodeAddr amode + code2 = registerCode register tmp + src__2 = registerName register tmp + sz = primRepToSize pk + code__2 = code1 `appOL` code2 `snocOL` ST sz src__2 dst__2 + in + returnNat code__2 + +assignReg_IntCode pk reg src + = getRegister src `thenNat` \ register2 -> + getRegisterReg reg `thenNat` \ register1 -> + let + dst__2 = registerName register1 (panic "###PPC where are we assigning this int???") + code = registerCode register2 dst__2 + src__2 = registerName register2 dst__2 + code__2 = if isFixed register2 + then code `snocOL` MR dst__2 src__2 + else code + in + returnNat code__2 + +#endif {- powerpc_TARGET_ARCH -} + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -2300,6 +2710,51 @@ assignReg_FltCode pk reg src #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH + +-- Floating point assignment to memory +assignMem_FltCode pk addr src + = getNewRegNCG pk `thenNat` \ tmp1 -> + getAmode addr `thenNat` \ amode -> + getRegister src `thenNat` \ register -> + let + sz = primRepToSize pk + dst__2 = amodeAddr amode + + code1 = amodeCode amode + code2 = registerCode register tmp1 + + src__2 = registerName register tmp1 + pk__2 = registerRep register + sz__2 = primRepToSize pk__2 + + code__2 = if pk__2 == DoubleRep || pk == pk__2 + then code1 `appOL` code2 `snocOL` ST sz src__2 dst__2 + else panic "###PPC MachCode.assignMem_FltCode: FloatRep" + {- code__2 = code1 `appOL` code2 `appOL` + if pk == pk__2 + then unitOL (ST sz src__2 dst__2) + else toOL [FxTOy sz__2 sz src__2 tmp1, ST sz tmp1 dst__2] -} + in + returnNat code__2 + +-- Floating point assignment to a register/temporary +assignReg_FltCode pk reg src + = getRegisterReg reg `thenNat` \ reg_dst -> + getRegister src `thenNat` \ reg_src -> + getNewRegNCG pk `thenNat` \ tmp -> + let + r_dst = registerName reg_dst tmp + r_src = registerName reg_src r_dst + c_src = registerCode reg_src r_dst + + code = if isFixed reg_src + then c_src `snocOL` MR r_dst r_src + else c_src + in + returnNat code +#endif {- powerpc_TARGET_ARCH -} + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -2397,6 +2852,22 @@ genJump dsts tree #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH +genJump dsts (StCLbl lbl) + = returnNat (toOL [BCC ALWAYS lbl]) + +genJump dsts tree + = getRegister tree `thenNat` \ register -> + getNewRegNCG PtrRep `thenNat` \ tmp -> + let + code = registerCode register tmp + target = registerName register tmp + in + returnNat (code `snocOL` MTCTR target `snocOL` BCTR) +#endif {- sparc_TARGET_ARCH -} + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -2612,6 +3083,22 @@ genCondJump lbl bool #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH + +genCondJump lbl bool + = getCondCode bool `thenNat` \ condition -> + let + code = condCode condition + cond = condName condition + target = ImmCLbl lbl + in + returnNat ( + code `snocOL` BCC cond lbl ) + +#endif {- powerpc_TARGET_ARCH -} + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -2959,6 +3446,111 @@ genCCall fn cconv kind args ) #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH +{- + The PowerPC calling convention (at least for Darwin/Mac OS X) + is described in Apple's document + "Inside Mac OS X - Mach-O Runtime Architecture". + Parameters may be passed in general-purpose registers, in + floating point registers, or on the stack. Stack space is + always reserved for parameters, even if they are passed in registers. + The called routine may choose to save parameters from registers + to the corresponding space on the stack. + The parameter area should be part of the 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 space that we should use as a parameter area for register + spilling, so we allocate a new stack frame just before ccalling. + That way we don't need to decide beforehand how much space to + reserve for parameters. +-} + +genCCall fn cconv kind args + = mapNat prepArg args `thenNat` \ preppedArgs -> + let + (argReps,argCodes,vregs) = unzip3 preppedArgs + + -- size of linkage area + size of arguments, in bytes + stackDelta = roundTo16 $ (24 +) $ (4 *) $ sum $ map getPrimRepSize argReps + roundTo16 x | x `mod` 16 == 0 = x + | otherwise = x + 16 - (x `mod` 16) + + move_sp_down = toOL [STU W sp (AddrRegImm sp (ImmInt (-stackDelta))), DELTA (-stackDelta)] + move_sp_up = toOL [ADD sp sp (RIImm (ImmInt stackDelta)), DELTA 0] + + (moveFinalCode,usedRegs) = move_final + (zip vregs argReps) + allArgRegs allFPArgRegs + eXTRA_STK_ARGS_HERE + (toOL []) [] + + passArguments = concatOL argCodes + `appOL` move_sp_down + `appOL` moveFinalCode + in + case fn of + Left lbl -> returnNat ( passArguments + `snocOL` BL (ImmLab False (ftext lbl)) usedRegs + `appOL` move_sp_up) + Right dyn -> + getRegister dyn `thenNat` \ dynReg -> + getNewRegNCG (registerRep dynReg) `thenNat` \ tmp -> + returnNat (registerCode dynReg tmp + `appOL` passArguments + `snocOL` MTCTR (registerName dynReg tmp) + `snocOL` BCTRL usedRegs + `appOL` move_sp_up) + where + prepArg arg + | is64BitRep (repOfStixExpr arg) + = iselExpr64 arg `thenNat` \ (ChildCode64 code vr_lo) -> + let r_lo = VirtualRegI vr_lo + r_hi = getHiVRegFromLo r_lo + in returnNat (repOfStixExpr arg, code, Right (r_hi,r_lo)) + | otherwise + = getRegister arg `thenNat` \ register -> + getNewRegNCG (registerRep register) `thenNat` \ tmp -> + returnNat (registerRep register, registerCode register tmp, Left (registerName register tmp)) + move_final [] _ _ _ accumCode accumUsed = (accumCode, accumUsed) + move_final ((Left vr,rep):vregs) gprs fprs stackOffset accumCode accumUsed + | not (is64BitRep rep) = + case rep of + FloatRep -> + move_final vregs (drop 1 gprs) (drop 1 fprs) (stackOffset+4) + (accumCode `snocOL` + (case fprs of + fpr : fprs -> MR fpr vr + [] -> ST F vr (AddrRegImm sp (ImmInt stackOffset)))) + ((take 1 fprs) ++ accumUsed) + DoubleRep -> + move_final vregs (drop 2 gprs) (drop 1 fprs) (stackOffset+8) + (accumCode `snocOL` + (case fprs of + fpr : fprs -> MR fpr vr + [] -> ST DF vr (AddrRegImm sp (ImmInt stackOffset)))) + ((take 1 fprs) ++ accumUsed) + VoidRep -> panic "MachCode.genCCall(powerpc): void parameter" + _ -> + move_final vregs (drop 1 gprs) fprs (stackOffset+4) + (accumCode `snocOL` + (case gprs of + gpr : gprs -> MR gpr vr + [] -> ST W vr (AddrRegImm sp (ImmInt stackOffset)))) + ((take 1 gprs) ++ accumUsed) + + move_final ((Right (vr_hi,vr_lo),rep):vregs) gprs fprs stackOffset accumCode accumUsed + | is64BitRep rep = + let + storeWord vr (gpr:_) offset = MR gpr vr + storeWord vr [] offset = ST W vr (AddrRegImm sp (ImmInt offset)) + in + move_final vregs (drop 2 gprs) fprs (stackOffset+8) + (accumCode + `snocOL` storeWord vr_hi gprs stackOffset + `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4)) + ((take 2 gprs) ++ accumUsed) +#endif {- powerpc_TARGET_ARCH -} + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -3125,6 +3717,34 @@ condFltReg cond x y #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH +condIntReg cond x y + = getNatLabelNCG `thenNat` \ lbl -> + condIntCode cond x y `thenNat` \ condition -> + let + code = condCode condition + cond = condName condition + code__2 dst = (LI dst (ImmInt 1) `consOL` code) `appOL` toOL [ + BCC cond lbl, + LI dst (ImmInt 0), + LABEL lbl] + in + returnNat (Any IntRep code__2) + +condFltReg cond x y + = getNatLabelNCG `thenNat` \ lbl -> + condFltCode cond x y `thenNat` \ condition -> + let + code = condCode condition + cond = condName condition + code__2 dst = (LI dst (ImmInt 1) `consOL` code) `appOL` toOL [ + BCC cond lbl, + LI dst (ImmInt 0), + LABEL lbl] + in + returnNat (Any IntRep code__2) +#endif {- powerpc_TARGET_ARCH -} + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -3149,7 +3769,8 @@ trivialCode ,IF_ARCH_i386 ((Operand -> Operand -> Instr) -> Maybe (Operand -> Operand -> Instr) ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr) - ,))) + ,IF_ARCH_powerpc((Reg -> Reg -> RI -> Instr) + ,)))) -> StixExpr -> StixExpr -- the two arguments -> NatM Register @@ -3158,7 +3779,8 @@ trivialFCode -> IF_ARCH_alpha((Reg -> Reg -> Reg -> Instr) ,IF_ARCH_sparc((Size -> Reg -> Reg -> Reg -> Instr) ,IF_ARCH_i386 ((Size -> Reg -> Reg -> Reg -> Instr) - ,))) + ,IF_ARCH_powerpc((Size -> Reg -> Reg -> Reg -> Instr) + ,)))) -> StixExpr -> StixExpr -- the two arguments -> NatM Register @@ -3166,7 +3788,8 @@ trivialUCode :: IF_ARCH_alpha((RI -> Reg -> Instr) ,IF_ARCH_i386 ((Operand -> Instr) ,IF_ARCH_sparc((RI -> Reg -> Instr) - ,))) + ,IF_ARCH_powerpc((Reg -> Reg -> Instr) + ,)))) -> StixExpr -- the one argument -> NatM Register @@ -3175,7 +3798,8 @@ trivialUFCode -> IF_ARCH_alpha((Reg -> Reg -> Instr) ,IF_ARCH_i386 ((Reg -> Reg -> Instr) ,IF_ARCH_sparc((Reg -> Reg -> Instr) - ,))) + ,IF_ARCH_powerpc((Reg -> Reg -> Instr) + ,)))) -> StixExpr -- the one argument -> NatM Register @@ -3520,6 +4144,90 @@ trivialUFCode pk instr x #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH +trivialCode instr x (StInt y) + | fits16Bits y + = getRegister x `thenNat` \ register -> + getNewRegNCG IntRep `thenNat` \ tmp -> + let + code = registerCode register tmp + src1 = registerName register tmp + src2 = ImmInt (fromInteger y) + code__2 dst = code `snocOL` instr dst src1 (RIImm src2) + in + returnNat (Any IntRep code__2) + +trivialCode instr x y + = getRegister x `thenNat` \ register1 -> + getRegister y `thenNat` \ register2 -> + getNewRegNCG IntRep `thenNat` \ tmp1 -> + getNewRegNCG IntRep `thenNat` \ tmp2 -> + let + code1 = registerCode register1 tmp1 + src1 = registerName register1 tmp1 + code2 = registerCode register2 tmp2 + src2 = registerName register2 tmp2 + code__2 dst = code1 `appOL` code2 `snocOL` + instr dst src1 (RIReg src2) + in + returnNat (Any IntRep code__2) + +trivialCode2 :: (Reg -> Reg -> Reg -> Instr) + -> StixExpr -> StixExpr -> NatM Register +trivialCode2 instr x y + = getRegister x `thenNat` \ register1 -> + getRegister y `thenNat` \ register2 -> + getNewRegNCG IntRep `thenNat` \ tmp1 -> + getNewRegNCG IntRep `thenNat` \ tmp2 -> + let + code1 = registerCode register1 tmp1 + src1 = registerName register1 tmp1 + code2 = registerCode register2 tmp2 + src2 = registerName register2 tmp2 + code__2 dst = code1 `appOL` code2 `snocOL` + instr dst src1 src2 + in + returnNat (Any IntRep code__2) + +trivialFCode pk instr x y + = getRegister x `thenNat` \ register1 -> + getRegister y `thenNat` \ register2 -> + getNewRegNCG (registerRep register1) + `thenNat` \ tmp1 -> + getNewRegNCG (registerRep register2) + `thenNat` \ tmp2 -> + -- getNewRegNCG DoubleRep `thenNat` \ tmp -> + let + -- promote x = FxTOy F DF x tmp + + pk1 = registerRep register1 + code1 = registerCode register1 tmp1 + src1 = registerName register1 tmp1 + + pk2 = registerRep register2 + code2 = registerCode register2 tmp2 + src2 = registerName register2 tmp2 + + code__2 dst = + if pk1 == pk2 then + code1 `appOL` code2 `snocOL` + instr (primRepToSize pk) src1 src2 dst + else panic "###PPC MachCode.trivialFCode: type mismatch" + in + returnNat (Any (if pk1 == pk2 then pk1 else DoubleRep) code__2) + +trivialUCode instr x + = getRegister x `thenNat` \ register -> + getNewRegNCG IntRep `thenNat` \ tmp -> + let + code = registerCode register tmp + src = registerName register tmp + code__2 dst = code `snocOL` instr dst src + in + returnNat (Any IntRep code__2) +trivialUFCode pk instr x = panic "###PPC MachCode.trivialUFCode" +#endif {- powerpc_TARGET_ARCH -} + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} @@ -3673,5 +4381,12 @@ coerceFlt2Dbl x #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH +coerceInt2FP pk x = panic "###PPC MachCode.coerceInt2FP" +coerceFP2Int fprep x = panic "###PPC MachCode.coerceFP2Int" +coerceDbl2Flt x = panic "###PPC MachCode.coerceDbl2Flt" +coerceFlt2Dbl x = panic "###PPC MachCode.coerceFlt2Dbl" +#endif {- powerpc_TARGET_ARCH -} + -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \end{code} diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index 70d7d06..40f7872 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -33,6 +33,10 @@ module MachMisc ( #if sparc_TARGET_ARCH RI(..), riZero, fpRelEA, moveSp, fPair #endif +#if powerpc_TARGET_ARCH + , RI(..) + , condUnsigned, condToSigned +#endif ) where #include "HsVersions.h" @@ -90,7 +94,7 @@ where do we start putting the rest of them? \begin{code} eXTRA_STK_ARGS_HERE :: Int eXTRA_STK_ARGS_HERE - = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23,???))) + = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23, IF_ARCH_powerpc(24,???)))) \end{code} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -235,6 +239,19 @@ data Cond | VC | VS #endif +#if powerpc_TARGET_ARCH + = ALWAYS + | EQQ + | GE + | GEU + | GTT + | GU + | LE + | LEU + | LTT + | LU + | NE +#endif deriving Eq -- to make an assertion work \end{code} @@ -264,7 +281,7 @@ data Size | DF -- IEEE single-precision floating pt | F80 -- Intel 80-bit internal FP format; only used for spilling #endif -#if sparc_TARGET_ARCH +#if sparc_TARGET_ARCH || powerpc_TARGET_ARCH = B -- byte (signed) | Bu -- byte (unsigned) | H -- halfword (signed, 2 bytes) @@ -276,28 +293,28 @@ data Size primRepToSize :: PrimRep -> Size -primRepToSize PtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize CodePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize DataPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize RetRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize CostCentreRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize CharRep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) +primRepToSize PtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize CodePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize DataPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize RetRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize CostCentreRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize CharRep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) -primRepToSize Int8Rep = IF_ARCH_alpha(B, IF_ARCH_i386(B, IF_ARCH_sparc(B, ))) -primRepToSize Int16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(W, IF_ARCH_sparc(H, ))) +primRepToSize Int8Rep = IF_ARCH_alpha(B, IF_ARCH_i386(B, IF_ARCH_sparc(B, IF_ARCH_powerpc(B, )))) +primRepToSize Int16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(W, IF_ARCH_sparc(H, IF_ARCH_powerpc(H, )))) where err = primRepToSize_fail "Int16Rep" -primRepToSize Int32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize Word8Rep = IF_ARCH_alpha(Bu, IF_ARCH_i386(Bu, IF_ARCH_sparc(Bu, ))) -primRepToSize Word16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(Wu, IF_ARCH_sparc(Hu, ))) +primRepToSize Int32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize Word8Rep = IF_ARCH_alpha(Bu, IF_ARCH_i386(Bu, IF_ARCH_sparc(Bu, IF_ARCH_powerpc(Bu, )))) +primRepToSize Word16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(Wu, IF_ARCH_sparc(Hu, IF_ARCH_powerpc(Hu, )))) where err = primRepToSize_fail "Word16Rep" -primRepToSize Word32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(Lu, IF_ARCH_sparc(W, ))) +primRepToSize Word32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(Lu, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) -primRepToSize IntRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize WordRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize AddrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) -primRepToSize FloatRep = IF_ARCH_alpha(TF, IF_ARCH_i386(F, IF_ARCH_sparc(F, ))) -primRepToSize DoubleRep = IF_ARCH_alpha(TF, IF_ARCH_i386(DF, IF_ARCH_sparc(DF, ))) -primRepToSize StablePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) +primRepToSize IntRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize WordRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize AddrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) +primRepToSize FloatRep = IF_ARCH_alpha(TF, IF_ARCH_i386(F, IF_ARCH_sparc(F, IF_ARCH_powerpc(F, )))) +primRepToSize DoubleRep = IF_ARCH_alpha(TF, IF_ARCH_i386(DF, IF_ARCH_sparc(DF, IF_ARCH_powerpc(DF, )))) +primRepToSize StablePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, )))) primRepToSize Word64Rep = primRepToSize_fail "Word64Rep" primRepToSize Int64Rep = primRepToSize_fail "Int64Rep" @@ -700,3 +717,67 @@ fPair (RealReg n) | n >= 32 && n `mod` 2 == 0 = RealReg (n+1) fPair other = pprPanic "fPair(sparc NCG)" (ppr other) #endif {- sparc_TARGET_ARCH -} \end{code} + +\begin{code} +#ifdef powerpc_TARGET_ARCH +-- data Instr continues... + +-- Loads and stores. + + | LD Size Reg MachRegsAddr -- size, dst, src + | ST Size Reg MachRegsAddr -- size, src, dst + | STU Size Reg MachRegsAddr -- size, src, dst + | LIS Reg Imm -- dst, src + | LI Reg Imm -- dst, src + | MR Reg Reg -- dst, src -- also for fmr + + | CMP Size Reg RI --- size, src1, src2 + | CMPL Size Reg RI --- size, src1, src2 + + | BCC Cond CLabel + | MTCTR Reg + | BCTR + | BL Imm [Reg] -- with list of argument regs + | BCTRL [Reg] + + | ADD Reg Reg RI -- dst, src1, src2 + | SUBF Reg Reg RI -- dst, src1, src2 + | MULLW Reg Reg RI + | DIVW Reg Reg Reg + | DIVWU Reg Reg Reg + + | AND Reg Reg RI -- dst, src1, src2 + | OR Reg Reg RI -- dst, src1, src2 + | XOR Reg Reg RI -- dst, src1, src2 + + | NEG Reg Reg + | NOT Reg Reg + + | SLW Reg Reg RI + | SRW Reg Reg RI + | SRAW Reg Reg RI + + | FADD Size Reg Reg Reg + | FSUB Size Reg Reg Reg + | FMUL Size Reg Reg Reg + | FDIV Size Reg Reg Reg + + | FCMP Reg Reg + +data RI = RIReg Reg + | RIImm Imm + +condUnsigned GU = True +condUnsigned LU = True +condUnsigned GEU = True +condUnsigned LEU = True +condUnsigned _ = False + +condToSigned GU = GTT +condToSigned LU = LTT +condToSigned GEU = GE +condToSigned LEU = LE +condToSigned x = x +#endif {- powerpc_TARGET_ARCH -} +\end{code} + diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs index 90ba29d..dae36c1 100644 --- a/ghc/compiler/nativeGen/MachRegs.lhs +++ b/ghc/compiler/nativeGen/MachRegs.lhs @@ -50,6 +50,13 @@ module MachRegs ( , fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27 #endif +#if powerpc_TARGET_ARCH + , allFPArgRegs + , fits16Bits + , sp + , r3, r4, r27, r28 + , f1, f20, f21 +#endif ) where #include "HsVersions.h" @@ -83,7 +90,11 @@ data Imm IF_ARCH_sparc( | LO Imm -- Possible restrictions... | HI Imm - ,) + ,IF_ARCH_powerpc( + | LO Imm + | HI Imm + | HA Imm -- high halfword adjusted + ,)) strImmLit s = ImmLit (text s) \end{code} @@ -111,6 +122,11 @@ type Displacement = Imm | AddrRegImm Reg Imm #endif +#if powerpc_TARGET_ARCH + = AddrRegReg Reg Reg + | AddrRegImm Reg Imm +#endif + addrOffset :: MachRegsAddr -> Int -> Maybe MachRegsAddr addrOffset addr off @@ -143,6 +159,23 @@ addrOffset addr off _ -> Nothing #endif {-sparc-} +#if powerpc_TARGET_ARCH + AddrRegImm r (ImmInt n) + | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2)) + | otherwise -> Nothing + where n2 = n + off + + AddrRegImm r (ImmInteger n) + | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2))) + | otherwise -> Nothing + where n2 = n + toInteger off + + AddrRegReg r (RealReg 0) + | fits16Bits off -> Just (AddrRegImm r (ImmInt off)) + | otherwise -> Nothing + + _ -> Nothing +#endif {-powerpc-} ----------------- #if alpha_TARGET_ARCH @@ -165,6 +198,11 @@ largeOffsetError i "\nworkaround: use -fvia-C on this module.\n") #endif {-sparc-} + +#if powerpc_TARGET_ARCH +fits16Bits :: Integral a => a -> Bool +fits16Bits x = x >= -32768 && x < 32768 +#endif \end{code} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -503,6 +541,38 @@ f1 = RealReg (fReg 1) #endif \end{code} +The PowerPC has 64 registers of interest; 32 integer registers and 32 floating +point registers. +\begin{code} +#if powerpc_TARGET_ARCH +fReg :: Int -> Int +fReg x = (32 + x) + +regClass (VirtualRegI u) = RcInteger +regClass (VirtualRegF u) = RcFloat +regClass (VirtualRegD u) = RcDouble +regClass (RealReg i) | i < 32 = RcInteger + | otherwise = RcDouble + -- | i < nCG_FirstFloatReg = RcDouble + -- | otherwise = RcFloat + +showReg :: Int -> String +showReg n + | n >= 0 && n <= 31 = "%r" ++ show n + | n >= 32 && n <= 63 = "%f" ++ show (n - 32) + | otherwise = "%unknown_powerpc_real_reg_" ++ show n + +sp = RealReg 1 +r3 = RealReg 3 +r4 = RealReg 4 +r27 = RealReg 27 +r28 = RealReg 28 +f1 = RealReg $ fReg 1 +f20 = RealReg $ fReg 20 +f21 = RealReg $ fReg 21 +#endif +\end{code} + Redefine the literals used for machine-registers with non-numeric names in the header files. Gag me with a spoon, eh? \begin{code} @@ -622,7 +692,73 @@ names in the header files. Gag me with a spoon, eh? #define f29 61 #define f30 62 #define f31 63 +#endif +#if powerpc_TARGET_ARCH +#define r0 0 +#define r1 1 +#define r2 2 +#define r3 3 +#define r4 4 +#define r5 5 +#define r6 6 +#define r7 7 +#define r8 8 +#define r9 9 +#define r10 10 +#define r11 11 +#define r12 12 +#define r13 13 +#define r14 14 +#define r15 15 +#define r16 16 +#define r17 17 +#define r18 18 +#define r19 19 +#define r20 20 +#define r21 21 +#define r22 22 +#define r23 23 +#define r24 24 +#define r25 25 +#define r26 26 +#define r27 27 +#define r28 28 +#define r29 29 +#define r30 30 +#define r31 31 +#define f0 32 +#define f1 33 +#define f2 34 +#define f3 35 +#define f4 36 +#define f5 37 +#define f6 38 +#define f7 39 +#define f8 40 +#define f9 41 +#define f10 42 +#define f11 43 +#define f12 44 +#define f13 45 +#define f14 46 +#define f15 47 +#define f16 48 +#define f17 49 +#define f18 50 +#define f19 51 +#define f20 52 +#define f21 53 +#define f22 54 +#define f23 55 +#define f24 56 +#define f25 57 +#define f26 58 +#define f27 59 +#define f28 60 +#define f29 61 +#define f30 62 +#define f31 63 #endif \end{code} @@ -832,7 +968,8 @@ allMachRegNos IF_ARCH_sparc( ([0..31] ++ [f0,f2 .. nCG_FirstFloatReg-1] ++ [nCG_FirstFloatReg .. f31]), - ))) + IF_ARCH_powerpc([0..63], + )))) -- allocatableRegs is allMachRegNos with the fixed-use regs removed. -- i.e., these are the regs for which we are prepared to allow the -- register allocator to attempt to map VRegs to. @@ -865,6 +1002,9 @@ callClobberedRegs [gReg i | i <- [1..7]] ++ [fReg i | i <- [0..31]] ) #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH + map RealReg ([0..12] ++ map fReg [0..13]) +#endif {- powerpc_TARGET_ARCH -} ------------------------------- -- argRegs is the set of regs which are read for an n-argument call to C. @@ -899,6 +1039,19 @@ argRegs 6 = map (RealReg . oReg) [0,1,2,3,4,5] argRegs _ = panic "MachRegs.argRegs(sparc): don't know about >6 arguments!" #endif {- sparc_TARGET_ARCH -} +#if powerpc_TARGET_ARCH +argRegs 0 = [] +argRegs 1 = map RealReg [3] +argRegs 2 = map RealReg [3,4] +argRegs 3 = map RealReg [3..5] +argRegs 4 = map RealReg [3..6] +argRegs 5 = map RealReg [3..7] +argRegs 6 = map RealReg [3..8] +argRegs 7 = map RealReg [3..9] +argRegs 8 = map RealReg [3..10] +argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!" +#endif {- powerpc_TARGET_ARCH -} + ------------------------------- -- all of the arg regs ?? #if alpha_TARGET_ARCH @@ -915,6 +1068,13 @@ allArgRegs = map RealReg [oReg i | i <- [0..5]] allArgRegs :: [Reg] allArgRegs = panic "MachRegs.allArgRegs(x86): should not be used!" #endif + +#if powerpc_TARGET_ARCH +allArgRegs :: [Reg] +allArgRegs = map RealReg [3..10] +allFPArgRegs :: [Reg] +allFPArgRegs = map (RealReg . fReg) [1..13] +#endif {- powerpc_TARGET_ARCH -} \end{code} \begin{code} @@ -946,6 +1106,15 @@ freeReg f0 = fastBool False -- %f0/%f1 are the C fp return registers. freeReg f1 = fastBool False #endif +#if powerpc_TARGET_ARCH +freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free +freeReg 1 = fastBool False -- The Stack Pointer +#if !darwin_TARGET_OS + -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that +freeReg 2 = fastBool False +#endif +#endif + #ifdef REG_Base freeReg REG_Base = fastBool False #endif diff --git a/ghc/compiler/nativeGen/NCG.h b/ghc/compiler/nativeGen/NCG.h index 9d11c21..a5c5d3e 100644 --- a/ghc/compiler/nativeGen/NCG.h +++ b/ghc/compiler/nativeGen/NCG.h @@ -65,6 +65,11 @@ you will screw up the layout where they are used in case expressions! # define BYTES_PER_WORD_STR "4" #endif +#if powerpc_TARGET_ARCH +# define BYTES_PER_WORD 4 +# define BYTES_PER_WORD_STR "4" +#endif + --------------------------------------------- #if alpha_TARGET_ARCH @@ -142,4 +147,16 @@ you will screw up the layout where they are used in case expressions! # define IF_OS_solaris2(x,y) y #endif --------------------------------------------- +#if powerpc_TARGET_ARCH +# define IF_ARCH_powerpc(x,y) x +#else +# define IF_ARCH_powerpc(x,y) y +#endif +-- - - - - - - - - - - - - - - - - - - - - - +#if darwin_TARGET_OS +# define IF_OS_darwin(x,y) x +#else +# define IF_OS_darwin(x,y) y +#endif +--------------------------------------------- #endif diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 564a799..1265384 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -176,6 +176,45 @@ pprReg IF_ARCH_i386(s,) r _ -> SLIT("very naughty sparc register") }) #endif +#if powerpc_TARGET_ARCH + ppr_reg_no :: Int -> Doc + ppr_reg_no i = ptext + (case i of { + 0 -> SLIT("r0"); 1 -> SLIT("r1"); + 2 -> SLIT("r2"); 3 -> SLIT("r3"); + 4 -> SLIT("r4"); 5 -> SLIT("r5"); + 6 -> SLIT("r6"); 7 -> SLIT("r7"); + 8 -> SLIT("r8"); 9 -> SLIT("r9"); + 10 -> SLIT("r10"); 11 -> SLIT("r11"); + 12 -> SLIT("r12"); 13 -> SLIT("r13"); + 14 -> SLIT("r14"); 15 -> SLIT("r15"); + 16 -> SLIT("r16"); 17 -> SLIT("r17"); + 18 -> SLIT("r18"); 19 -> SLIT("r19"); + 20 -> SLIT("r20"); 21 -> SLIT("r21"); + 22 -> SLIT("r22"); 23 -> SLIT("r23"); + 24 -> SLIT("r24"); 25 -> SLIT("r25"); + 26 -> SLIT("r26"); 27 -> SLIT("r27"); + 28 -> SLIT("r28"); 29 -> SLIT("r29"); + 30 -> SLIT("r30"); 31 -> SLIT("r31"); + 32 -> SLIT("f0"); 33 -> SLIT("f1"); + 34 -> SLIT("f2"); 35 -> SLIT("f3"); + 36 -> SLIT("f4"); 37 -> SLIT("f5"); + 38 -> SLIT("f6"); 39 -> SLIT("f7"); + 40 -> SLIT("f8"); 41 -> SLIT("f9"); + 42 -> SLIT("f10"); 43 -> SLIT("f11"); + 44 -> SLIT("f12"); 45 -> SLIT("f13"); + 46 -> SLIT("f14"); 47 -> SLIT("f15"); + 48 -> SLIT("f16"); 49 -> SLIT("f17"); + 50 -> SLIT("f18"); 51 -> SLIT("f19"); + 52 -> SLIT("f20"); 53 -> SLIT("f21"); + 54 -> SLIT("f22"); 55 -> SLIT("f23"); + 56 -> SLIT("f24"); 57 -> SLIT("f25"); + 58 -> SLIT("f26"); 59 -> SLIT("f27"); + 60 -> SLIT("f28"); 61 -> SLIT("f29"); + 62 -> SLIT("f30"); 63 -> SLIT("f31"); + _ -> SLIT("very naughty powerpc register") + }) +#endif \end{code} %************************************************************************ @@ -231,6 +270,15 @@ pprStSize x = ptext (case x of F -> SLIT("") DF -> SLIT("d") #endif +#if powerpc_TARGET_ARCH + B -> SLIT("b") + Bu -> SLIT("b") + H -> SLIT("h") + Hu -> SLIT("h") + W -> SLIT("w") + F -> SLIT("fs") + DF -> SLIT("fd") +#endif ) \end{code} @@ -274,6 +322,14 @@ pprCond c = ptext (case c of { NEG -> SLIT("neg"); POS -> SLIT("pos"); VC -> SLIT("vc"); VS -> SLIT("vs") #endif +#if powerpc_TARGET_ARCH + ALWAYS -> SLIT(""); + EQQ -> SLIT("eq"); NE -> SLIT("ne"); + LTT -> SLIT("lt"); GE -> SLIT("ge"); + GTT -> SLIT("gt"); LE -> SLIT("le"); + LU -> SLIT("lt"); GEU -> SLIT("ge"); + GU -> SLIT("gt"); LEU -> SLIT("le"); +#endif }) \end{code} @@ -309,6 +365,22 @@ pprImm (HI i) where pp_hi = text "%hi(" #endif +#if powerpc_TARGET_ARCH +pprImm (LO i) + = hcat [ pp_lo, pprImm i, rparen ] + where + pp_lo = text "lo16(" + +pprImm (HI i) + = hcat [ pp_hi, pprImm i, rparen ] + where + pp_hi = text "hi16(" + +pprImm (HA i) + = hcat [ pp_ha, pprImm i, rparen ] + where + pp_ha = text "ha16(" +#endif \end{code} %************************************************************************ @@ -375,6 +447,8 @@ pprAddr (AddrRegImm r1 (ImmInt i)) pprAddr (AddrRegImm r1 (ImmInteger i)) | i == 0 = pprReg r1 | not (fits13Bits i) = largeOffsetError i +------------------- + | otherwise = hcat [ pprReg r1, pp_sign, integer i ] where pp_sign = if i > 0 then char '+' else empty @@ -382,6 +456,14 @@ pprAddr (AddrRegImm r1 (ImmInteger i)) pprAddr (AddrRegImm r1 imm) = hcat [ pprReg r1, char '+', pprImm imm ] #endif +#if powerpc_TARGET_ARCH +pprAddr (AddrRegReg r1 r2) + = error "PprMach.pprAddr (AddrRegReg) unimplemented" + +pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ] +pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ] +pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ] +#endif \end{code} %************************************************************************ @@ -398,7 +480,8 @@ pprInstr (COMMENT s) = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s)) ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s)) ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s)) - ,))) + ,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s)) + ,)))) pprInstr (DELTA d) = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) @@ -407,21 +490,24 @@ pprInstr (SEGMENT TextSegment) = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-} ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-} ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-} - ,))) + ,IF_ARCH_powerpc(ptext SLIT(".text\n.align 2") + ,)))) pprInstr (SEGMENT DataSegment) = ptext IF_ARCH_alpha(SLIT("\t.data\n\t.align 3") ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -} ,IF_ARCH_i386(SLIT(".data\n\t.align 4") - ,))) + ,IF_ARCH_powerpc(SLIT(".data\n.align 2") + ,)))) pprInstr (SEGMENT RoDataSegment) = ptext IF_ARCH_alpha(SLIT("\t.data\n\t.align 3") ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -} ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4") - ,))) + ,IF_ARCH_powerpc(SLIT(".const_data\n.align 2") + ,)))) pprInstr (LABEL clab) = let @@ -435,7 +521,8 @@ pprInstr (LABEL clab) IF_ARCH_alpha(SLIT("\t.globl\t") ,IF_ARCH_i386(SLIT(".globl ") ,IF_ARCH_sparc(SLIT(".global\t") - ,))) + ,IF_ARCH_powerpc(SLIT(".globl ") + ,)))) , pp_lab, char '\n'], pp_lab, char ':' @@ -484,6 +571,19 @@ pprInstr (DATA s xs) = let bs = doubleToBytes (fromRational r) in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs #endif +#if powerpc_TARGET_ARCH + ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x] + ppr_item Bu x = [ptext SLIT("\t.byte\t") <> pprImm x] + ppr_item H x = [ptext SLIT("\t.byte\t") <> pprImm x] + ppr_item Hu x = [ptext SLIT("\t.byte\t") <> pprImm x] + ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x] + ppr_item F (ImmFloat r) + = let bs = floatToBytes (fromRational r) + in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs + ppr_item DF (ImmDouble r) + = let bs = doubleToBytes (fromRational r) + in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs +#endif -- fall through to rest of (machine-specific) pprInstr... \end{code} @@ -1734,6 +1834,212 @@ pp_comma_a = text ",a" #endif {-sparc_TARGET_ARCH-} \end{code} +%************************************************************************ +%* * +\subsubsection{@pprInstr@ for PowerPC} +%* * +%************************************************************************ + +\begin{code} +#if powerpc_TARGET_ARCH +pprInstr (LD sz reg addr) = hcat [ + char '\t', + ptext SLIT("l"), + ptext (case sz of + B -> SLIT("ba") + Bu -> SLIT("bz") + H -> SLIT("ha") + Hu -> SLIT("hz") + W -> SLIT("wz") + F -> SLIT("fs") + DF -> SLIT("fd")), + char '\t', + pprReg reg, + ptext SLIT(", "), + pprAddr addr + ] +pprInstr (ST sz reg addr) = hcat [ + char '\t', + ptext SLIT("st"), + pprSize sz, + char '\t', + pprReg reg, + ptext SLIT(", "), + pprAddr addr + ] +pprInstr (STU sz reg addr) = hcat [ + char '\t', + ptext SLIT("st"), + pprSize sz, + ptext SLIT("u\t"), + pprReg reg, + ptext SLIT(", "), + pprAddr addr + ] +pprInstr (LIS reg imm) = hcat [ + char '\t', + ptext SLIT("lis"), + char '\t', + pprReg reg, + ptext SLIT(", "), + pprImm imm + ] +pprInstr (LI reg imm) = hcat [ + char '\t', + ptext SLIT("li"), + char '\t', + pprReg reg, + ptext SLIT(", "), + pprImm imm + ] +pprInstr (MR reg1 reg2) = hcat [ + char '\t', + case regClass reg1 of + RcInteger -> ptext SLIT("mr") + _ -> ptext SLIT("fmr"), + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2 + ] +pprInstr (CMP sz reg ri) = hcat [ + char '\t', + op, + char '\t', + pprReg reg, + ptext SLIT(", "), + pprRI ri + ] + where + op = hcat [ + ptext SLIT("cmp"), + pprSize sz, + case ri of + RIReg _ -> empty + RIImm _ -> char 'i' + ] +pprInstr (CMPL sz reg ri) = hcat [ + char '\t', + op, + char '\t', + pprReg reg, + ptext SLIT(", "), + pprRI ri + ] + where + op = hcat [ + ptext SLIT("cmpl"), + pprSize sz, + case ri of + RIReg _ -> empty + RIImm _ -> char 'i' + ] +pprInstr (BCC cond lbl) = hcat [ + char '\t', + ptext SLIT("b"), + pprCond cond, + char '\t', + pprCLabel_asm lbl + ] + +pprInstr (MTCTR reg) = hcat [ + char '\t', + ptext SLIT("mtctr"), + char '\t', + pprReg reg + ] +pprInstr (BCTR) = hcat [ + char '\t', + ptext SLIT("bctr") + ] +pprInstr (BL imm _) = hcat [ + char '\t', + ptext SLIT("bl"), + char '\t', + pprImm imm + ] +pprInstr (BCTRL _) = hcat [ + char '\t', + ptext SLIT("bctrl") + ] +pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri +pprInstr (SUBF reg1 reg2 ri) = pprLogic SLIT("subf") reg1 reg2 ri +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) +pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3) +pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri +pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri +pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri +pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 ri +pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 ri +pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 ri +pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2 +pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2 + +pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3 +pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3 +pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3 +pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3 + +pprInstr (FCMP reg1 reg2) = hcat [ + char '\t', + ptext SLIT("fcmpu\tcr0, "), + -- Note: we're using fcmpu, not fcmpo + -- The difference is with fcmpo, compare with NaN is an invalid operation. + -- We don't handle invalid fp ops, so we don't care + pprReg reg1, + ptext SLIT(", "), + pprReg reg2 + ] + +pprInstr _ = ptext SLIT("something") + +pprLogic op reg1 reg2 ri = hcat [ + char '\t', + ptext op, + case ri of + RIReg _ -> empty + RIImm _ -> char 'i', + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2, + ptext SLIT(", "), + pprRI ri + ] + +pprUnary op reg1 reg2 = hcat [ + char '\t', + ptext op, + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2 + ] + +pprBinaryF op sz reg1 reg2 reg3 = hcat [ + char '\t', + ptext op, + pprFSize sz, + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2, + ptext SLIT(", "), + pprReg reg3 + ] + +pprRI :: RI -> Doc +pprRI (RIReg r) = pprReg r +pprRI (RIImm r) = pprImm r + +pprFSize DF = empty +pprFSize F = char 's' + +#endif {-powerpc_TARGET_ARCH-} +\end{code} + \begin{code} #if __GLASGOW_HASKELL__ >= 504 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float) @@ -1765,6 +2071,8 @@ castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t) castFloatToCharArray = return castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t) + + castDoubleToCharArray = return #endif diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index 880a50e..eaa1a1b 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -386,6 +386,49 @@ regUsage instr = case instr of regRI _ = [] #endif {- sparc_TARGET_ARCH -} +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +#if powerpc_TARGET_ARCH + +regUsage instr = case instr of + LD sz reg addr -> usage (regAddr addr, [reg]) + ST sz reg addr -> usage (reg : regAddr addr, []) + STU sz reg addr -> usage (reg : regAddr addr, []) + LIS reg imm -> usage ([], [reg]) + LI reg imm -> usage ([], [reg]) + MR reg1 reg2 -> usage ([reg2], [reg1]) + CMP sz reg ri -> usage (reg : regRI ri,[]) + CMPL sz reg ri -> usage (reg : regRI ri,[]) + MTCTR reg -> usage ([reg],[]) + ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + SUBF reg1 reg2 ri -> usage (reg2 : regRI ri, [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]) + AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + SLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + SRW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + SRAW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + NEG reg1 reg2 -> usage ([reg2], [reg1]) + NOT reg1 reg2 -> usage ([reg2], [reg1]) + BL imm params -> usage (params, callClobberedRegs) + BCTRL params -> usage (params, callClobberedRegs) + FADD sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FSUB sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FMUL sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FDIV sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FCMP r1 r2 -> usage ([r1,r2], []) + _ -> noUsage + where + usage (src, dst) = RU (regSetFromList (filter interesting src)) + (regSetFromList (filter interesting dst)) + regAddr (AddrRegReg r1 r2) = [r1, r2] + regAddr (AddrRegImm r1 _) = [r1] + + regRI (RIReg r) = [r] + regRI _ = [] +#endif {- powerpc_TARGET_ARCH -} \end{code} @@ -463,6 +506,10 @@ findReservedRegs instrs in possibilities #endif +#if powerpc_TARGET_ARCH + = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2, + NCG_SpillTmp_D1, NCG_SpillTmp_D2]] +#endif \end{code} %************************************************************************ @@ -552,6 +599,16 @@ insnFuture insn boring -> Next #endif {- sparc_TARGET_ARCH -} +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +#if powerpc_TARGET_ARCH + BCC ALWAYS clbl | isAsmTemp clbl -> Branch clbl + | otherwise -> NoFuture + BCC _ clbl | isAsmTemp clbl -> NextOrBranch clbl + BCC _ _ -> panic "insnFuture: conditional jump to non-local label" + + BCTR -> NoFuture + boring -> Next +#endif {- powerpc_TARGET_ARCH -} \end{code} %************************************************************************ @@ -757,6 +814,47 @@ patchRegs instr env = case instr of fixRI other = other #endif {- sparc_TARGET_ARCH -} +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +#if powerpc_TARGET_ARCH + +patchRegs instr env = case instr of + LD sz reg addr -> LD sz (env reg) (fixAddr addr) + ST sz reg addr -> ST sz (env reg) (fixAddr addr) + STU sz reg addr -> STU sz (env reg) (fixAddr addr) + LIS reg imm -> LIS (env reg) imm + LI reg imm -> LI (env reg) imm + MR reg1 reg2 -> MR (env reg1) (env reg2) + CMP sz reg ri -> CMP sz (env reg) (fixRI ri) + CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri) + BCC cond lbl -> BCC cond lbl + MTCTR reg -> MTCTR (env reg) + BCTR -> BCTR + ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri) + SUBF reg1 reg2 ri -> SUBF (env reg1) (env reg2) (fixRI ri) + 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) + AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri) + OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri) + XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri) + SLW reg1 reg2 ri -> SLW (env reg1) (env reg2) (fixRI ri) + SRW reg1 reg2 ri -> SRW (env reg1) (env reg2) (fixRI ri) + SRAW reg1 reg2 ri -> SRAW (env reg1) (env reg2) (fixRI ri) + NEG reg1 reg2 -> NEG (env reg1) (env reg2) + NOT reg1 reg2 -> NOT (env reg1) (env reg2) + FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3) + FSUB sz r1 r2 r3 -> FSUB sz (env r1) (env r2) (env r3) + FMUL sz r1 r2 r3 -> FMUL sz (env r1) (env r2) (env r3) + FDIV sz r1 r2 r3 -> FDIV sz (env r1) (env r2) (env r3) + FCMP r1 r2 -> FCMP (env r1) (env r2) + _ -> instr + where + fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) + fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i + + fixRI (RIReg r) = RIReg (env r) + fixRI other = other +#endif {- powerpc_TARGET_ARCH -} \end{code} %************************************************************************ @@ -773,7 +871,7 @@ location. Leave 8 words (ie, 64 bytes for a 64-bit arch) of slop. \begin{code} spillSlotSize :: Int -spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, ))) +spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, IF_ARCH_powerpc( 8, )))) maxSpillSlots :: Int maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1 @@ -820,7 +918,13 @@ spillReg vreg_to_slot_map delta dyn vreg RcFloat -> F RcDouble -> DF in ST sz dyn (fpRel (- off_w)) - ,))) + ,IF_ARCH_powerpc( + let sz = case regClass vreg of + RcInteger -> W + RcFloat -> F + RcDouble -> DF + in ST sz dyn (AddrRegImm sp (ImmInt (off-delta))) + ,)))) loadReg vreg_to_slot_map delta vreg dyn @@ -842,5 +946,11 @@ loadReg vreg_to_slot_map delta vreg dyn RcFloat -> F RcDouble -> DF in LD sz (fpRel (- off_w)) dyn - ,))) + ,IF_ARCH_powerpc( + let sz = case regClass vreg of + RcInteger -> W + RcFloat -> F + RcDouble -> DF + in LD sz dyn (AddrRegImm sp (ImmInt (off-delta))) + ,)))) \end{code} -- 1.7.10.4