-----------------------------------------------------------------------------
module PPC.RegInfo (
- RegUsage(..),
- noUsage,
- regUsage,
- patchRegs,
- jumpDests,
- isJumpish,
- patchJump,
- isRegRegMove,
-
- JumpDest,
+ JumpDest( DestBlockId ),
canShortcut,
shortcutJump,
- mkSpillInstr,
- mkLoadInstr,
- mkRegRegMoveInstr,
- mkBranchInstr,
-
- spillSlotSize,
- maxSpillSlots,
- spillSlotToOffset
+ shortcutStatic
)
where
#include "nativeGen/NCG.h"
#include "HsVersions.h"
-import BlockId
-import Cmm
-import CLabel
-import RegsBase
import PPC.Regs
import PPC.Instr
-import Outputable
-import Constants ( rESERVED_C_STACK_BYTES )
-import FastBool
-
-data RegUsage = RU [Reg] [Reg]
-
-noUsage :: RegUsage
-noUsage = RU [] []
-
-regUsage :: Instr -> RegUsage
-regUsage instr = case instr of
- SPILL reg slot -> usage ([reg], [])
- RELOAD slot reg -> usage ([], [reg])
-
- LD sz reg addr -> usage (regAddr addr, [reg])
- LA 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,[])
- BCC cond lbl -> noUsage
- BCCFAR cond lbl -> noUsage
- MTCTR reg -> usage ([reg],[])
- BCTR targets -> noUsage
- BL imm params -> usage (params, callClobberedRegs)
- BCTRL params -> usage (params, callClobberedRegs)
- ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
- ADDC reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
- ADDE reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
- ADDIS reg1 reg2 imm -> usage ([reg2], [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_MayOflo 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])
- XORIS reg1 reg2 imm -> usage ([reg2], [reg1])
- EXTS siz reg1 reg2 -> 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])
- RLWINM reg1 reg2 sh mb me
- -> usage ([reg2], [reg1])
- 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])
- FRSP r1 r2 -> usage ([r2], [r1])
- MFCR reg -> usage ([], [reg])
- MFLR reg -> usage ([], [reg])
- FETCHPC reg -> usage ([], [reg])
- _ -> noUsage
- where
- usage (src, dst) = RU (filter interesting src)
- (filter interesting dst)
- regAddr (AddrRegReg r1 r2) = [r1, r2]
- regAddr (AddrRegImm r1 _) = [r1]
-
- regRI (RIReg r) = [r]
- regRI _ = []
-interesting :: Reg -> Bool
-interesting (VirtualRegI _) = True
-interesting (VirtualRegHi _) = True
-interesting (VirtualRegF _) = True
-interesting (VirtualRegD _) = True
-interesting (RealReg i) = isFastTrue (freeReg i)
-
-
--- -----------------------------------------------------------------------------
--- 'patchRegs' function
-
--- 'patchRegs' takes an instruction and applies the given mapping to
--- all the register references.
-
-patchRegs :: Instr -> (Reg -> Reg) -> Instr
-patchRegs instr env = case instr of
- SPILL reg slot -> SPILL (env reg) slot
- RELOAD slot reg -> RELOAD slot (env reg)
-
- LD sz reg addr -> LD sz (env reg) (fixAddr addr)
- LA sz reg addr -> LA 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
- BCCFAR cond lbl -> BCCFAR cond lbl
- MTCTR reg -> MTCTR (env reg)
- BCTR targets -> BCTR targets
- 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)
- ADDC reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3)
- ADDE reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3)
- ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm
- 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_MayOflo reg1 reg2 reg3
- -> MULLW_MayOflo (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)
- XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
- EXTS sz reg1 reg2 -> EXTS sz (env reg1) (env reg2)
- 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)
- RLWINM reg1 reg2 sh mb me
- -> RLWINM (env reg1) (env reg2) sh mb me
- 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)
- FRSP r1 r2 -> FRSP (env r1) (env r2)
- MFCR reg -> MFCR (env reg)
- MFLR reg -> MFLR (env reg)
- FETCHPC reg -> FETCHPC (env reg)
- _ -> 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
-
-
-
-jumpDests :: Instr -> [BlockId] -> [BlockId]
-jumpDests insn acc
- = case insn of
- BCC _ id -> id : acc
- BCCFAR _ id -> id : acc
- BCTR targets -> targets ++ acc
- _ -> acc
-
-
--- | Check whether a particular instruction is a jump, branch or call instruction (jumpish)
--- We can't just use jumpDests above because the jump might take its arg,
--- so the instr won't contain a blockid.
---
-isJumpish :: Instr -> Bool
-isJumpish instr
- = case instr of
- BCC{} -> True
- BCCFAR{} -> True
- JMP{} -> True
-
-
--- | Change the destination of this jump instruction
--- Used in joinToTargets in the linear allocator, when emitting fixup code
--- for join points.
-patchJump :: Instr -> BlockId -> BlockId -> Instr
-patchJump insn old new
- = case insn of
- BCC cc id
- | id == old -> BCC cc new
-
- BCCFAR cc id
- | id == old -> BCCFAR cc new
-
- BCTR targets -> error "Cannot patch BCTR"
-
- _ -> insn
-
-
-isRegRegMove :: Instr -> Maybe (Reg,Reg)
-isRegRegMove (MR dst src) = Just (src,dst)
-isRegRegMove _ = Nothing
+import BlockId
+import OldCmm
+import CLabel
+import Outputable
+import Unique
data JumpDest = DestBlockId BlockId | DestImm Imm
canShortcut _ = Nothing
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
-shortcutJump fn other = other
-
-
-
-
--- -----------------------------------------------------------------------------
--- Generating spill instructions
-
-mkSpillInstr
- :: Reg -- register to spill
- -> Int -- current stack delta
- -> Int -- spill slot to use
- -> Instr
-mkSpillInstr reg delta slot
- = let off = spillSlotToOffset slot
- in
- let sz = case regClass reg of
- RcInteger -> II32
- RcDouble -> FF64
- in ST sz reg (AddrRegImm sp (ImmInt (off-delta)))
-
-
-mkLoadInstr
- :: Reg -- register to load
- -> Int -- current stack delta
- -> Int -- spill slot to use
- -> Instr
-mkLoadInstr reg delta slot
- = let off = spillSlotToOffset slot
- in
- let sz = case regClass reg of
- RcInteger -> II32
- RcDouble -> FF64
- in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
-
-
-mkRegRegMoveInstr
- :: Reg
- -> Reg
- -> Instr
-mkRegRegMoveInstr src dst
- = MR dst src
+shortcutJump _ other = other
-mkBranchInstr
- :: BlockId
- -> [Instr]
+-- Here because it knows about JumpDest
+shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
-mkBranchInstr id = [BCC ALWAYS id]
+shortcutStatic fn (CmmStaticLit (CmmLabel lab))
+ | Just uq <- maybeAsmTemp lab
+ = CmmStaticLit (CmmLabel (shortBlockId fn (mkBlockId uq)))
+shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
+ | Just uq <- maybeAsmTemp lbl1
+ = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (mkBlockId uq)) lbl2 off)
+ -- slightly dodgy, we're ignoring the second label, but this
+ -- works with the way we use CmmLabelDiffOff for jump tables now.
+shortcutStatic _ other_static
+ = other_static
-spillSlotSize :: Int
-spillSlotSize = 8
+shortBlockId
+ :: (BlockId -> Maybe JumpDest)
+ -> BlockId
+ -> CLabel
-maxSpillSlots :: Int
-maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
+shortBlockId fn blockid =
+ case fn blockid of
+ Nothing -> mkAsmTempLabel uq
+ Just (DestBlockId blockid') -> shortBlockId fn blockid'
+ Just (DestImm (ImmCLbl lbl)) -> lbl
+ _other -> panic "shortBlockId"
+ where uq = getUnique blockid
--- convert a spill slot number to a *byte* offset, with no sign:
--- decide on a per arch basis whether you are spilling above or below
--- the C stack pointer.
-spillSlotToOffset :: Int -> Int
-spillSlotToOffset slot
- | slot >= 0 && slot < maxSpillSlots
- = 64 + spillSlotSize * slot
- | otherwise
- = pprPanic "spillSlotToOffset:"
- ( text "invalid spill location: " <> int slot
- $$ text "maxSpillSlots: " <> int maxSpillSlots)
projects / ghc-hetmet.git / blobdiff