From 21934a0a7bb582b57d737164699548eae0399fb7 Mon Sep 17 00:00:00 2001 From: wolfgang Date: Thu, 13 Feb 2003 15:45:06 +0000 Subject: [PATCH] [project @ 2003-02-13 15:45:05 by wolfgang] support many more MachOps in the PowerPC NCG --- ghc/compiler/nativeGen/MachCode.lhs | 166 +++++++++++++++++++++++++------ ghc/compiler/nativeGen/MachMisc.lhs | 23 +++-- ghc/compiler/nativeGen/PprMach.lhs | 33 +++++- ghc/compiler/nativeGen/RegAllocInfo.lhs | 24 +++-- 4 files changed, 197 insertions(+), 49 deletions(-) diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index e9fbdf4..e88fb83 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -1595,8 +1595,10 @@ getRegister (StMachOp mop [x]) -- unary MachOps MO_16S_to_NatS -> integerExtend True 16 x MO_8U_to_32U -> integerExtend False 24 x - other -> pprPanic "getRegister(powerpc) - unary StMachOp" - (pprMachOp mop) + MO_Flt_Neg -> trivialUFCode FloatRep FNEG x + MO_Dbl_Neg -> trivialUFCode FloatRep FNEG x + + other_op -> getRegister (StCall (Left fn) CCallConv DoubleRep [x]) where integerExtend signed nBits x = getRegister ( @@ -1607,6 +1609,44 @@ getRegister (StMachOp mop [x]) -- unary MachOps = getRegister expr `thenNat` \ e_code -> returnNat (swizzleRegisterRep e_code new_rep) + (is_float_op, fn) + = case mop of + MO_Flt_Exp -> (True, FSLIT("exp")) + MO_Flt_Log -> (True, FSLIT("log")) + MO_Flt_Sqrt -> (True, FSLIT("sqrt")) + + MO_Flt_Sin -> (True, FSLIT("sin")) + MO_Flt_Cos -> (True, FSLIT("cos")) + MO_Flt_Tan -> (True, FSLIT("tan")) + + MO_Flt_Asin -> (True, FSLIT("asin")) + MO_Flt_Acos -> (True, FSLIT("acos")) + MO_Flt_Atan -> (True, FSLIT("atan")) + + MO_Flt_Sinh -> (True, FSLIT("sinh")) + MO_Flt_Cosh -> (True, FSLIT("cosh")) + MO_Flt_Tanh -> (True, FSLIT("tanh")) + + MO_Dbl_Exp -> (False, FSLIT("exp")) + MO_Dbl_Log -> (False, FSLIT("log")) + MO_Dbl_Sqrt -> (False, FSLIT("sqrt")) + + MO_Dbl_Sin -> (False, FSLIT("sin")) + MO_Dbl_Cos -> (False, FSLIT("cos")) + MO_Dbl_Tan -> (False, FSLIT("tan")) + + MO_Dbl_Asin -> (False, FSLIT("asin")) + MO_Dbl_Acos -> (False, FSLIT("acos")) + MO_Dbl_Atan -> (False, FSLIT("atan")) + + MO_Dbl_Sinh -> (False, FSLIT("sinh")) + MO_Dbl_Cosh -> (False, FSLIT("cosh")) + MO_Dbl_Tanh -> (False, FSLIT("tanh")) + + other -> pprPanic "getRegister(powerpc) - unary StMachOp" + (pprMachOp mop) + + getRegister (StMachOp mop [x, y]) -- dyadic PrimOps = case mop of MO_32U_Gt -> condIntReg GTT x y @@ -1648,10 +1688,14 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps MO_NatS_Mul -> trivialCode MULLW x y MO_NatU_Mul -> trivialCode MULLW x y + -- MO_NatS_MulMayOflo -> MO_NatS_Quot -> trivialCode2 DIVW x y MO_NatU_Quot -> trivialCode2 DIVWU x y + MO_NatS_Rem -> remainderCode DIVW x y + MO_NatU_Rem -> remainderCode DIVWU x y + MO_Nat_And -> trivialCode AND x y MO_Nat_Or -> trivialCode OR x y MO_Nat_Xor -> trivialCode XOR x y @@ -1659,17 +1703,7 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps 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 @@ -1679,13 +1713,12 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps 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] + [x, y]) 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) @@ -2729,15 +2762,8 @@ assignMem_FltCode pk addr src 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] -} + code__2 = code1 `appOL` code2 `snocOL` ST sz src__2 dst__2 in returnNat code__2 @@ -4217,13 +4243,13 @@ trivialFCode pk instr x y code2 = registerCode register2 tmp2 src2 = registerName register2 tmp2 + dstRep = if pk1 == FloatRep && pk2 == FloatRep then FloatRep else DoubleRep + code__2 dst = - if pk1 == pk2 then code1 `appOL` code2 `snocOL` - instr (primRepToSize pk) dst src1 src2 - else panic "###PPC MachCode.trivialFCode: type mismatch" + instr (primRepToSize dstRep) dst src1 src2 in - returnNat (Any (if pk1 == pk2 then pk1 else DoubleRep) code__2) + returnNat (Any dstRep code__2) trivialUCode instr x = getRegister x `thenNat` \ register -> @@ -4234,7 +4260,41 @@ trivialUCode instr x code__2 dst = code `snocOL` instr dst src in returnNat (Any IntRep code__2) -trivialUFCode pk instr x = panic "###PPC MachCode.trivialUFCode" +trivialUFCode pk instr x + = getRegister x `thenNat` \ register -> + getNewRegNCG (registerRep register) + `thenNat` \ tmp -> + let + code = registerCode register tmp + src = registerName register tmp + code__2 dst = code `snocOL` instr dst src + in + returnNat (Any pk code__2) + +-- There is no "remainder" instruction on the PPC, so we have to do +-- it the hard way. +-- The "div" parameter is the division instruction to use (DIVW or DIVWU) + +remainderCode :: (Reg -> Reg -> Reg -> Instr) + -> StixExpr -> StixExpr -> NatM Register +remainderCode div 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 `appOL` toOL [ + div dst src1 src2, + MULLW dst dst (RIReg src2), + SUBF dst dst (RIReg src1) + ] + in + returnNat (Any IntRep code__2) + #endif {- powerpc_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -4391,8 +4451,50 @@ coerceFlt2Dbl x #endif {- sparc_TARGET_ARCH -} #if powerpc_TARGET_ARCH -coerceInt2FP pk x = panic "###PPC MachCode.coerceInt2FP" -coerceFP2Int fprep x = panic "###PPC MachCode.coerceFP2Int" +coerceInt2FP pk x + = ASSERT(pk == DoubleRep) + getRegister x `thenNat` \ register -> + getNewRegNCG IntRep `thenNat` \ reg -> + getNatLabelNCG `thenNat` \ lbl -> + getNewRegNCG PtrRep `thenNat` \ itmp -> + getNewRegNCG DoubleRep `thenNat` \ ftmp -> + let + code = registerCode register reg + src = registerName register reg + code__2 dst = code `appOL` toOL [ + SEGMENT RoDataSegment, + LABEL lbl, + DATA W [ImmInt 0x43300000, ImmInt 0x80000000], + SEGMENT TextSegment, + XORIS itmp src (ImmInt 0x8000), + ST W itmp (spRel (-1)), + LIS itmp (ImmInt 0x4330), + ST W itmp (spRel (-2)), + LD DF ftmp (spRel (-2)), + LIS itmp (HA (ImmCLbl lbl)), + LD DF dst (AddrRegImm itmp (LO (ImmCLbl lbl))), + FSUB DF dst ftmp dst + ] + in + returnNat (Any DoubleRep code__2) + +coerceFP2Int fprep x + = ASSERT(fprep == DoubleRep || fprep == FloatRep) + getRegister x `thenNat` \ register -> + getNewRegNCG fprep `thenNat` \ reg -> + getNewRegNCG DoubleRep `thenNat` \ tmp -> + let + code = registerCode register reg + src = registerName register reg + code__2 dst = code `appOL` toOL [ + -- convert to int in FP reg + FCTIWZ tmp src, + -- store value (64bit) from FP to stack + ST DF tmp (spRel (-2)), + -- read low word of value (high word is undefined) + LD W dst (spRel (-1))] + in + returnNat (Any IntRep code__2) coerceDbl2Flt x = panic "###PPC MachCode.coerceDbl2Flt" coerceFlt2Dbl x = panic "###PPC MachCode.coerceFlt2Dbl" #endif {- powerpc_TARGET_ARCH -} diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index a51a607..1d3c3ac 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -724,12 +724,12 @@ fPair other = pprPanic "fPair(sparc NCG)" (ppr other) -- 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 + | LD Size Reg MachRegsAddr -- Load size, dst, src + | ST Size Reg MachRegsAddr -- Store size, src, dst + | STU Size Reg MachRegsAddr -- Store with Update size, src, dst + | LIS Reg Imm -- Load Immediate Shifted dst, src + | LI Reg Imm -- Load Immediate dst, src + | MR Reg Reg -- Move Register dst, src -- also for fmr | CMP Size Reg RI --- size, src1, src2 | CMPL Size Reg RI --- size, src1, src2 @@ -749,21 +749,26 @@ fPair other = pprPanic "fPair(sparc NCG)" (ppr other) | AND Reg Reg RI -- dst, src1, src2 | OR Reg Reg RI -- dst, src1, src2 | XOR Reg Reg RI -- dst, src1, src2 + | XORIS Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2 | NEG Reg Reg | NOT Reg Reg - | SLW Reg Reg RI - | SRW Reg Reg RI - | SRAW Reg Reg RI + | SLW Reg Reg RI -- shift left word + | SRW Reg Reg RI -- shift right word + | SRAW Reg Reg RI -- shift right arithmetic word | FADD Size Reg Reg Reg | FSUB Size Reg Reg Reg | FMUL Size Reg Reg Reg | FDIV Size Reg Reg Reg + | FNEG Reg Reg -- negate is the same for single and double prec. | FCMP Reg Reg + | FCTIWZ Reg Reg -- convert to integer word + -- (but destination is a FP register) + data RI = RIReg Reg | RIImm Imm diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 3bab396..3a38756 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -1892,7 +1892,9 @@ pprInstr (LI reg imm) = hcat [ ptext SLIT(", "), pprImm imm ] -pprInstr (MR reg1 reg2) = hcat [ +pprInstr (MR reg1 reg2) + | reg1 == reg2 = empty + | otherwise = hcat [ char '\t', case regClass reg1 of RcInteger -> ptext SLIT("mr") @@ -1968,9 +1970,35 @@ 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) + + -- for some reason, "andi" doesn't exist. + -- we'll use "andi." instead. +pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [ + char '\t', + ptext SLIT("andi."), + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2, + ptext SLIT(", "), + pprImm imm + ] 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 (XORIS reg1 reg2 imm) = hcat [ + char '\t', + ptext SLIT("xoris"), + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2, + ptext SLIT(", "), + pprImm imm + ] + 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 @@ -1981,6 +2009,7 @@ 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 (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2 pprInstr (FCMP reg1 reg2) = hcat [ char '\t', @@ -1993,6 +2022,8 @@ pprInstr (FCMP reg1 reg2) = hcat [ pprReg reg2 ] +pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2 + pprInstr _ = ptext SLIT("something") pprLogic op reg1 reg2 ri = hcat [ diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index eaa1a1b..b54113b 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -121,7 +121,7 @@ intersectionRegSets (MkRegSet xs1) (MkRegSet xs2) %************************************************************************ %* * -\subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions} +\subsection{@RegUsage@ type; @noUsage@ and @regUsage@ functions} %* * %************************************************************************ @@ -398,7 +398,11 @@ regUsage instr = case instr of MR reg1 reg2 -> usage ([reg2], [reg1]) CMP sz reg ri -> usage (reg : regRI ri,[]) CMPL sz reg ri -> usage (reg : regRI ri,[]) + BCC cond lbl -> noUsage MTCTR reg -> usage ([reg],[]) + BCTR -> noUsage + BL imm params -> usage (params, callClobberedRegs) + BCTRL params -> usage (params, callClobberedRegs) 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]) @@ -407,18 +411,19 @@ regUsage instr = case instr of 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]) + XORIS reg1 reg2 imm -> usage ([reg2], [reg1]) + NEG reg1 reg2 -> usage ([reg2], [reg1]) + NOT reg1 reg2 -> usage ([reg2], [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]) + FNEG r1 r2 -> usage ([r2], [r1]) FCMP r1 r2 -> usage ([r1,r2], []) + FCTIWZ r1 r2 -> usage ([r2], [r1]) _ -> noUsage where usage (src, dst) = RU (regSetFromList (filter interesting src)) @@ -829,6 +834,8 @@ patchRegs instr env = case instr of BCC cond lbl -> BCC cond lbl MTCTR reg -> MTCTR (env reg) BCTR -> BCTR + BL imm argRegs -> BL imm argRegs -- argument regs + BCTRL argRegs -> BCTRL argRegs -- cannot be remapped 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) @@ -837,16 +844,19 @@ patchRegs instr env = case instr of 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) + XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm + NEG reg1 reg2 -> NEG (env reg1) (env reg2) + NOT reg1 reg2 -> NOT (env reg1) (env reg2) 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) + FNEG r1 r2 -> FNEG (env r1) (env r2) FCMP r1 r2 -> FCMP (env r1) (env r2) + FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2) _ -> instr where fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) -- 1.7.10.4