diff options
Diffstat (limited to 'compiler/nativeGen/PPC/Instr.hs')
| -rw-r--r-- | compiler/nativeGen/PPC/Instr.hs | 71 |
1 files changed, 42 insertions, 29 deletions
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index eb179c5a99..8eb5e8fa8d 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -23,6 +23,8 @@ module PPC.Instr ( where +import GhcPrelude + import PPC.Regs import PPC.Cond import Instruction @@ -75,19 +77,19 @@ instance Instruction Instr where mkStackDeallocInstr = ppc_mkStackDeallocInstr -ppc_mkStackAllocInstr :: Platform -> Int -> Instr +ppc_mkStackAllocInstr :: Platform -> Int -> [Instr] ppc_mkStackAllocInstr platform amount = ppc_mkStackAllocInstr' platform (-amount) -ppc_mkStackDeallocInstr :: Platform -> Int -> Instr +ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr] ppc_mkStackDeallocInstr platform amount = ppc_mkStackAllocInstr' platform amount -ppc_mkStackAllocInstr' :: Platform -> Int -> Instr +ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr] ppc_mkStackAllocInstr' platform amount = case platformArch platform of - ArchPPC -> UPDATE_SP II32 (ImmInt amount) - ArchPPC_64 _ -> UPDATE_SP II64 (ImmInt amount) + ArchPPC -> [UPDATE_SP II32 (ImmInt amount)] + ArchPPC_64 _ -> [UPDATE_SP II64 (ImmInt amount)] _ -> panic $ "ppc_mkStackAllocInstr' " ++ show (platformArch platform) @@ -124,7 +126,7 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do insert_stack_insns (BasicBlock id insns) | Just new_blockid <- mapLookup id new_blockmap - = [ BasicBlock id [alloc, BCC ALWAYS new_blockid] + = [ BasicBlock id $ alloc ++ [BCC ALWAYS new_blockid Nothing] , BasicBlock new_blockid block' ] | otherwise @@ -137,11 +139,11 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do -- "labeled-goto" we use JMP, and for "computed-goto" we -- use MTCTR followed by BCTR. See 'PPC.CodeGen.genJump'. = case insn of - JMP _ -> dealloc : insn : r - BCTR [] Nothing -> dealloc : insn : r + JMP _ -> dealloc ++ (insn : r) + BCTR [] Nothing -> dealloc ++ (insn : r) BCTR ids label -> BCTR (map (fmap retarget) ids) label : r - BCCFAR cond b -> BCCFAR cond (retarget b) : r - BCC cond b -> BCC cond (retarget b) : r + BCCFAR cond b p -> BCCFAR cond (retarget b) p : r + BCC cond b p -> BCC cond (retarget b) p : r _ -> insn : r -- BL and BCTRL are call-like instructions rather than -- jumps, and are used only for C calls. @@ -190,10 +192,12 @@ data Instr -- Loads and stores. | LD Format Reg AddrMode -- Load format, dst, src | LDFAR Format Reg AddrMode -- Load format, dst, src 32 bit offset + | LDR Format Reg AddrMode -- Load and reserve format, dst, src | LA Format Reg AddrMode -- Load arithmetic format, dst, src | ST Format Reg AddrMode -- Store format, src, dst | STFAR Format Reg AddrMode -- Store format, src, dst 32 bit offset | STU Format Reg AddrMode -- Store with Update format, src, dst + | STC Format Reg AddrMode -- Store conditional format, 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 @@ -201,8 +205,12 @@ data Instr | CMP Format Reg RI -- format, src1, src2 | CMPL Format Reg RI -- format, src1, src2 - | BCC Cond BlockId - | BCCFAR Cond BlockId + | BCC Cond BlockId (Maybe Bool) -- cond, block, hint + | BCCFAR Cond BlockId (Maybe Bool) -- cond, block, hint + -- hint: + -- Just True: branch likely taken + -- Just False: branch likely not taken + -- Nothing: no hint | JMP CLabel -- same as branch, -- but with CLabel instead of block ID | MTCTR Reg @@ -232,6 +240,7 @@ data Instr | DIV Format Bool Reg Reg Reg | AND Reg Reg RI -- dst, src1, src2 | ANDC Reg Reg Reg -- AND with complement, dst = src1 & ~ src2 + | NAND Reg Reg Reg -- dst, src1, src2 | OR Reg Reg RI -- dst, src1, src2 | ORIS Reg Reg Imm -- OR Immediate Shifted dst, src1, src2 | XOR Reg Reg RI -- dst, src1, src2 @@ -272,6 +281,8 @@ data Instr | MFLR Reg -- move from link register | FETCHPC Reg -- pseudo-instruction: -- bcl to next insn, mflr reg + | HWSYNC -- heavy weight sync + | ISYNC -- instruction synchronize | LWSYNC -- memory barrier | NOP -- no operation, PowerPC 64 bit -- needs this as place holder to @@ -290,17 +301,19 @@ ppc_regUsageOfInstr platform instr = case instr of LD _ reg addr -> usage (regAddr addr, [reg]) LDFAR _ reg addr -> usage (regAddr addr, [reg]) + LDR _ reg addr -> usage (regAddr addr, [reg]) LA _ reg addr -> usage (regAddr addr, [reg]) ST _ reg addr -> usage (reg : regAddr addr, []) STFAR _ reg addr -> usage (reg : regAddr addr, []) STU _ reg addr -> usage (reg : regAddr addr, []) + STC _ reg addr -> usage (reg : regAddr addr, []) LIS reg _ -> usage ([], [reg]) LI reg _ -> usage ([], [reg]) MR reg1 reg2 -> usage ([reg2], [reg1]) CMP _ reg ri -> usage (reg : regRI ri,[]) CMPL _ reg ri -> usage (reg : regRI ri,[]) - BCC _ _ -> noUsage - BCCFAR _ _ -> noUsage + BCC _ _ _ -> noUsage + BCCFAR _ _ _ -> noUsage MTCTR reg -> usage ([reg],[]) BCTR _ _ -> noUsage BL _ params -> usage (params, callClobberedRegs platform) @@ -325,6 +338,7 @@ ppc_regUsageOfInstr platform instr AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) ANDC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) + NAND reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1]) OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) ORIS reg1 reg2 _ -> usage ([reg2], [reg1]) XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) @@ -380,17 +394,19 @@ ppc_patchRegsOfInstr instr env = case instr of LD fmt reg addr -> LD fmt (env reg) (fixAddr addr) LDFAR fmt reg addr -> LDFAR fmt (env reg) (fixAddr addr) + LDR fmt reg addr -> LDR fmt (env reg) (fixAddr addr) LA fmt reg addr -> LA fmt (env reg) (fixAddr addr) ST fmt reg addr -> ST fmt (env reg) (fixAddr addr) STFAR fmt reg addr -> STFAR fmt (env reg) (fixAddr addr) STU fmt reg addr -> STU fmt (env reg) (fixAddr addr) + STC fmt reg addr -> STC fmt (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 fmt reg ri -> CMP fmt (env reg) (fixRI ri) CMPL fmt reg ri -> CMPL fmt (env reg) (fixRI ri) - BCC cond lbl -> BCC cond lbl - BCCFAR cond lbl -> BCCFAR cond lbl + BCC cond lbl p -> BCC cond lbl p + BCCFAR cond lbl p -> BCCFAR cond lbl p MTCTR reg -> MTCTR (env reg) BCTR targets lbl -> BCTR targets lbl BL imm argRegs -> BL imm argRegs -- argument regs @@ -417,6 +433,7 @@ ppc_patchRegsOfInstr instr env AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri) ANDC reg1 reg2 reg3 -> ANDC (env reg1) (env reg2) (env reg3) + NAND reg1 reg2 reg3 -> NAND (env reg1) (env reg2) (env reg3) OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri) ORIS reg1 reg2 imm -> ORIS (env reg1) (env reg2) imm XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri) @@ -480,8 +497,8 @@ ppc_isJumpishInstr instr ppc_jumpDestsOfInstr :: Instr -> [BlockId] ppc_jumpDestsOfInstr insn = case insn of - BCC _ id -> [id] - BCCFAR _ id -> [id] + BCC _ id _ -> [id] + BCCFAR _ id _ -> [id] BCTR targets _ -> [id | Just id <- targets] _ -> [] @@ -492,8 +509,8 @@ ppc_jumpDestsOfInstr insn ppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr ppc_patchJumpInstr insn patchF = case insn of - BCC cc id -> BCC cc (patchF id) - BCCFAR cc id -> BCCFAR cc (patchF id) + BCC cc id p -> BCC cc (patchF id) p + BCCFAR cc id p -> BCCFAR cc (patchF id) p BCTR ids lbl -> BCTR (map (fmap patchF) ids) lbl _ -> insn @@ -631,16 +648,12 @@ ppc_mkRegRegMoveInstr src dst -- | Make an unconditional jump instruction. --- For architectures with branch delay slots, its ok to put --- a NOP after the jump. Don't fill the delay slot with an --- instruction that references regs or you'll confuse the --- linear allocator. ppc_mkJumpInstr :: BlockId -> [Instr] ppc_mkJumpInstr id - = [BCC ALWAYS id] + = [BCC ALWAYS id Nothing] -- | Take the source and destination from this reg -> reg move instruction @@ -669,12 +682,12 @@ makeFarBranches info_env blocks handleBlock addr (BasicBlock id instrs) = BasicBlock id (zipWith makeFar [addr..] instrs) - makeFar _ (BCC ALWAYS tgt) = BCC ALWAYS tgt - makeFar addr (BCC cond tgt) + makeFar _ (BCC ALWAYS tgt _) = BCC ALWAYS tgt Nothing + makeFar addr (BCC cond tgt p) | abs (addr - targetAddr) >= nearLimit - = BCCFAR cond tgt + = BCCFAR cond tgt p | otherwise - = BCC cond tgt + = BCC cond tgt p where Just targetAddr = lookupUFM blockAddressMap tgt makeFar _ other = other |