----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 1996-2004 -- ----------------------------------------------------------------------------- module Alpha.RegInfo ( {- RegUsage(..), noUsage, regUsage, patchRegs, jumpDests, isJumpish, patchJump, isRegRegMove, JumpDest, canShortcut, shortcutJump, shortcutStatic, maxSpillSlots, mkSpillInstr, mkLoadInstr, mkRegRegMoveInstr, mkBranchInstr -} ) where {- #include "nativeGen/NCG.h" #include "HsVersions.h" import BlockId import Cmm import CLabel import Instrs import Regs 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 B reg addr -> usage (regAddr addr, [reg, t9]) LD Bu reg addr -> usage (regAddr addr, [reg, t9]) -- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED -- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED LD sz reg addr -> usage (regAddr addr, [reg]) LDA reg addr -> usage (regAddr addr, [reg]) LDAH reg addr -> usage (regAddr addr, [reg]) LDGP reg addr -> usage (regAddr addr, [reg]) LDI sz reg imm -> usage ([], [reg]) ST B reg addr -> usage (reg : regAddr addr, [t9, t10]) -- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED ST sz reg addr -> usage (reg : regAddr addr, []) CLR reg -> usage ([], [reg]) ABS sz ri reg -> usage (regRI ri, [reg]) NEG sz ov ri reg -> usage (regRI ri, [reg]) ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) NOT ri reg -> usage (regRI ri, [reg]) AND r1 ar r2 -> usage (r1 : regRI ar, [r2]) ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) OR r1 ar r2 -> usage (r1 : regRI ar, [r2]) ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) XOR r1 ar r2 -> usage (r1 : regRI ar, [r2]) XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2]) ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2]) FCLR reg -> usage ([], [reg]) FABS r1 r2 -> usage ([r1], [r2]) FNEG sz r1 r2 -> usage ([r1], [r2]) FADD sz r1 r2 r3 -> usage ([r1, r2], [r3]) FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3]) FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3]) FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3]) CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2]) FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3]) FMOV r1 r2 -> usage ([r1], [r2]) -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line. BI cond reg lbl -> usage ([reg], []) BF cond reg lbl -> usage ([reg], []) JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet BSR _ n -> RU (argRegSet n) callClobberedRegSet JSR reg addr n -> RU (argRegSet n) callClobberedRegSet _ -> noUsage where usage (src, dst) = RU (mkRegSet (filter interesting src)) (mkRegSet (filter interesting dst)) interesting (FixedReg _) = False interesting _ = True regAddr (AddrReg r1) = [r1] regAddr (AddrRegImm r1 _) = [r1] regAddr (AddrImm _) = [] regRI (RIReg r) = [r] regRI _ = [] 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) LDA reg addr -> LDA (env reg) (fixAddr addr) LDAH reg addr -> LDAH (env reg) (fixAddr addr) LDGP reg addr -> LDGP (env reg) (fixAddr addr) LDI sz reg imm -> LDI sz (env reg) imm ST sz reg addr -> ST sz (env reg) (fixAddr addr) CLR reg -> CLR (env reg) ABS sz ar reg -> ABS sz (fixRI ar) (env reg) NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg) ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2) SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2) SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2) SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2) MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2) DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2) REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2) NOT ar reg -> NOT (fixRI ar) (env reg) AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2) ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2) OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2) ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2) XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2) XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2) SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2) SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2) SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2) ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2) ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2) CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2) FCLR reg -> FCLR (env reg) FABS r1 r2 -> FABS (env r1) (env r2) FNEG s r1 r2 -> FNEG s (env r1) (env r2) FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3) FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3) FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3) FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3) CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2) FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3) FMOV r1 r2 -> FMOV (env r1) (env r2) BI cond reg lbl -> BI cond (env reg) lbl BF cond reg lbl -> BF cond (env reg) lbl JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint JSR reg addr i -> JSR (env reg) (fixAddr addr) i _ -> instr where fixAddr (AddrReg r1) = AddrReg (env r1) fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i fixAddr other = other fixRI (RIReg r) = RIReg (env r) fixRI other = other mkSpillInstr :: Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use -> Instr mkSpillInstr reg delta slot = let off = spillSlotToOffset slot in -- Alpha: spill below the stack pointer (?) ST sz dyn (spRel (- (off `div` 8))) mkLoadInstr :: Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use -> Instr mkLoadInstr reg delta slot = let off = spillSlotToOffset slot in LD sz dyn (spRel (- (off `div` 8))) mkBranchInstr :: BlockId -> [Instr] mkBranchInstr id = [BR id] -}