Fix two bugs in the PowerPC NCG:
1. it generated a 'subfi' (subtract from with immediate) instruction,
which doesn't exist in the PowerPC architecture.
2. didn't correctly handle switch tables (test case cg048.hs).
MERGE TO STABLE
import CmdLineOpts ( opt_Static )
import Stix ( pprStixStmt )
import CmdLineOpts ( opt_Static )
import Stix ( pprStixStmt )
+import Maybe ( fromMaybe )
+
-- DEBUGGING ONLY
import Outputable ( assertPanic )
import FastString
-- DEBUGGING ONLY
import Outputable ( assertPanic )
import FastString
MO_Dbl_Le -> condFltReg LE x y
MO_Nat_Add -> trivialCode ADD x y
MO_Dbl_Le -> condFltReg LE x y
MO_Nat_Add -> trivialCode ADD x y
- MO_Nat_Sub -> trivialCode SUBF y x
+ MO_Nat_Sub -> fromMaybe (trivialCode2 SUBF y x) $
+ case y of -- subfi ('substract from' with immediate) doesn't exist
+ StInt imm -> if fits16Bits imm && imm /= (-32768)
+ then Just $ trivialCode ADD x (StInt (-imm))
+ else Nothing
+ _ -> Nothing
MO_NatS_Mul -> trivialCode MULLW x y
MO_NatU_Mul -> trivialCode MULLW x y
MO_NatS_Mul -> trivialCode MULLW x y
MO_NatU_Mul -> trivialCode MULLW x y
#if powerpc_TARGET_ARCH
genJump dsts (StCLbl lbl)
#if powerpc_TARGET_ARCH
genJump dsts (StCLbl lbl)
- = returnNat (toOL [BCC ALWAYS lbl])
+ | hasDestInfo dsts = panic "genJump(powerpc): CLbl and dsts"
+ | otherwise = returnNat (toOL [BCC ALWAYS lbl])
genJump dsts tree
= getRegister tree `thenNat` \ register ->
genJump dsts tree
= getRegister tree `thenNat` \ register ->
code = registerCode register tmp
target = registerName register tmp
in
code = registerCode register tmp
target = registerName register tmp
in
- returnNat (code `snocOL` MTCTR target `snocOL` BCTR)
+ returnNat (code `snocOL` MTCTR target `snocOL` BCTR dsts)
#endif {- sparc_TARGET_ARCH -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#endif {- sparc_TARGET_ARCH -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
code__2 dst = code1 `appOL` code2 `appOL` toOL [
div dst src1 src2,
MULLW dst dst (RIReg src2),
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)
]
in
returnNat (Any IntRep code__2)
| BCC Cond CLabel
| MTCTR Reg
| BCC Cond CLabel
| MTCTR Reg
| BL Imm [Reg] -- with list of argument regs
| BCTRL [Reg]
| ADD Reg Reg RI -- dst, src1, src2
| BL Imm [Reg] -- with list of argument regs
| BCTRL [Reg]
| ADD Reg Reg RI -- dst, src1, src2
- | SUBF Reg Reg RI -- dst, src1, src2
+ | SUBF Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1
| MULLW Reg Reg RI
| DIVW Reg Reg Reg
| DIVWU Reg Reg Reg
| MULLW Reg Reg RI
| DIVW Reg Reg Reg
| DIVWU Reg Reg Reg
-pprInstr (BCTR) = hcat [
+pprInstr (BCTR _) = hcat [
char '\t',
ptext SLIT("bctr")
]
char '\t',
ptext SLIT("bctr")
]
ptext SLIT("bctrl")
]
pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
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 (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
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)
CMPL sz reg ri -> usage (reg : regRI ri,[])
BCC cond lbl -> noUsage
MTCTR reg -> usage ([reg],[])
CMPL sz reg ri -> usage (reg : regRI ri,[])
BCC cond lbl -> noUsage
MTCTR reg -> usage ([reg],[])
BL imm params -> usage (params, callClobberedRegs)
BCTRL params -> usage (params, callClobberedRegs)
ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
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])
+ SUBF reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
MULLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
DIVW reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
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])
BCC _ clbl | isAsmTemp clbl -> NextOrBranch clbl
BCC _ _ -> panic "insnFuture: conditional jump to non-local label"
BCC _ clbl | isAsmTemp clbl -> NextOrBranch clbl
BCC _ _ -> panic "insnFuture: conditional jump to non-local label"
+ BCTR (DestInfo dsts) -> MultiFuture dsts
+ BCTR NoDestInfo -> NoFuture
boring -> Next
#endif {- powerpc_TARGET_ARCH -}
\end{code}
boring -> Next
#endif {- powerpc_TARGET_ARCH -}
\end{code}
CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri)
BCC cond lbl -> BCC cond lbl
MTCTR reg -> MTCTR (env reg)
CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri)
BCC cond lbl -> BCC cond lbl
MTCTR reg -> MTCTR (env reg)
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)
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)
+ SUBF reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri)
DIVW reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
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)