#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(..),
= 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 -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 ->
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)
#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}
#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}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#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])
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}
#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}
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
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
#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}
#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}
#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}
#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}
)
#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}
#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}
,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
-> 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
:: 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
-> 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
#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}
#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}
#if sparc_TARGET_ARCH
RI(..), riZero, fpRelEA, moveSp, fPair
#endif
+#if powerpc_TARGET_ARCH
+ , RI(..)
+ , condUnsigned, condToSigned
+#endif
) where
#include "HsVersions.h"
\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}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
| 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}
| 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)
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"
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}
+
_ -> 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}
%************************************************************************
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}
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}
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}
%************************************************************************
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
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}
%************************************************************************
= 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)))
= 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
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 ':'
= 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}
#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)
castFloatToCharArray = return
castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
+
+
castDoubleToCharArray = return
#endif
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}
in
possibilities
#endif
+#if powerpc_TARGET_ARCH
+ = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
+ NCG_SpillTmp_D1, NCG_SpillTmp_D2]]
+#endif
\end{code}
%************************************************************************
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}
%************************************************************************
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}
%************************************************************************
\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
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
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}
projects / ghc-hetmet.git / commitdiff