X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FRegAllocInfo.hs;h=98c4e2dfe061310d19ec1cfc1481f1c1e819e5c7;hb=9772b3f828280e89ef9ea1cce28752dee216f23e;hp=1987c286b0bb93e86d4689753a6966bf659cc676;hpb=eec59c80b2733b11be71c109e7fd908cc4e49fbd;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/RegAllocInfo.hs b/ghc/compiler/nativeGen/RegAllocInfo.hs index 1987c28..98c4e2d 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.hs +++ b/ghc/compiler/nativeGen/RegAllocInfo.hs @@ -14,19 +14,20 @@ module RegAllocInfo ( regUsage, patchRegs, jumpDests, + patchJump, isRegRegMove, maxSpillSlots, mkSpillInstr, mkLoadInstr, + mkRegRegMoveInstr, + mkBranchInstr ) where #include "HsVersions.h" import Cmm ( BlockId ) -#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH -import MachOp ( MachRep(..) ) -#endif +import MachOp ( MachRep(..), wordRep ) import MachInstrs import MachRegs import Outputable @@ -161,16 +162,16 @@ regUsage instr = case instr of SHL sz imm dst -> usageRM imm dst SAR sz imm dst -> usageRM imm dst SHR sz imm dst -> usageRM imm dst - BT sz imm src -> mkRU (use_R src) [] + BT sz imm src -> mkRUR (use_R src) - PUSH sz op -> mkRU (use_R op) [] + PUSH sz op -> mkRUR (use_R op) POP sz op -> mkRU [] (def_W op) - TEST sz src dst -> mkRU (use_R src ++ use_R dst) [] - CMP sz src dst -> mkRU (use_R src ++ use_R dst) [] + TEST sz src dst -> mkRUR (use_R src ++ use_R dst) + CMP sz src dst -> mkRUR (use_R src ++ use_R dst) SETCC cond op -> mkRU [] (def_W op) JXX cond lbl -> mkRU [] [] - JMP op -> mkRU (use_R op) [] - JMP_TBL op ids -> mkRU (use_R op) [] + JMP op -> mkRUR (use_R op) + JMP_TBL op ids -> mkRUR (use_R op) CALL (Left imm) params -> mkRU params callClobberedRegs CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs CLTD sz -> mkRU [eax] [edx] @@ -179,7 +180,7 @@ regUsage instr = case instr of #if i386_TARGET_ARCH GMOV src dst -> mkRU [src] [dst] GLD sz src dst -> mkRU (use_EA src) [dst] - GST sz src dst -> mkRU (src : use_EA dst) [] + GST sz src dst -> mkRUR (src : use_EA dst) GLDZ dst -> mkRU [] [dst] GLD1 dst -> mkRU [] [dst] @@ -195,7 +196,7 @@ regUsage instr = case instr of GMUL sz s1 s2 dst -> mkRU [s1,s2] [dst] GDIV sz s1 s2 dst -> mkRU [s1,s2] [dst] - GCMP sz src1 src2 -> mkRU [src1,src2] [] + GCMP sz src1 src2 -> mkRUR [src1,src2] GABS sz src dst -> mkRU [src] [dst] GNEG sz src dst -> mkRU [src] [dst] GSQRT sz src dst -> mkRU [src] [dst] @@ -215,6 +216,7 @@ regUsage instr = case instr of #endif FETCHGOT reg -> mkRU [] [reg] + FETCHPC reg -> mkRU [] [reg] COMMENT _ -> noUsage DELTA _ -> noUsage @@ -231,17 +233,17 @@ regUsage instr = case instr of -- 2 operand form; first operand Read; second Written usageRW :: Operand -> Operand -> RegUsage usageRW op (OpReg reg) = mkRU (use_R op) [reg] - usageRW op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) [] + usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) -- 2 operand form; first operand Read; second Modified usageRM :: Operand -> Operand -> RegUsage usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg] - usageRM op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) [] + usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) -- 1 operand form; operand Modified usageM :: Operand -> RegUsage usageM (OpReg reg) = mkRU [reg] [reg] - usageM (OpAddr ea) = mkRU (use_EA ea) [] + usageM (OpAddr ea) = mkRUR (use_EA ea) -- Registers defd when an operand is written. def_W (OpReg reg) = [reg] @@ -261,8 +263,12 @@ regUsage instr = case instr of use_index EAIndexNone = [] use_index (EAIndex i _) = [i] - mkRU src dst = RU (filter interesting src) - (filter interesting dst) + mkRUR src = src' `seq` RU src' [] + where src' = filter interesting src + + mkRU src dst = src' `seq` dst' `seq` RU src' dst' + where src' = filter interesting src + dst' = filter interesting dst #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -298,7 +304,7 @@ regUsage instr = case instr of FxTOy s1 s2 r1 r2 -> usage ([r1], [r2]) -- We assume that all local jumps will be BI/BF. JMP must be out-of-line. - JMP dst addr -> usage (regAddr addr, []) + JMP addr -> usage (regAddr addr, []) CALL (Left imm) n True -> noUsage CALL (Left imm) n False -> usage (argRegs n, callClobberedRegs) @@ -307,8 +313,8 @@ regUsage instr = case instr of _ -> noUsage where - usage (src, dst) = RU (regSetFromList (filter interesting src)) - (regSetFromList (filter interesting dst)) + usage (src, dst) = RU (filter interesting src) + (filter interesting dst) regAddr (AddrRegReg r1 r2) = [r1, r2] regAddr (AddrRegImm r1 _) = [r1] @@ -399,6 +405,18 @@ jumpDests insn acc #endif _other -> acc +patchJump :: Instr -> BlockId -> BlockId -> Instr + +patchJump insn old new + = case insn of +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH + JXX cc id | id == old -> JXX cc new + JMP_TBL op ids -> error "Cannot patch JMP_TBL" +#elif powerpc_TARGET_ARCH + BCC cc id | id == old -> BCC cc new + BCTR targets -> error "Cannot patch BCTR" +#endif + _other -> insn -- ----------------------------------------------------------------------------- -- 'patchRegs' function @@ -539,7 +557,8 @@ patchRegs instr env = case instr of CALL (Right reg) p -> CALL (Right (env reg)) p FETCHGOT reg -> FETCHGOT (env reg) - + FETCHPC reg -> FETCHPC (env reg) + NOP -> instr COMMENT _ -> instr DELTA _ -> instr @@ -599,7 +618,7 @@ patchRegs instr env = case instr of FSQRT s r1 r2 -> FSQRT s (env r1) (env r2) FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3) FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2) - JMP dsts addr -> JMP dsts (fixAddr addr) + JMP addr -> JMP (fixAddr addr) CALL (Left i) n t -> CALL (Left i) n t CALL (Right r) n t -> CALL (Right (env r)) n t _ -> instr @@ -722,11 +741,11 @@ mkSpillInstr reg delta slot #ifdef sparc_TARGET_ARCH {-SPARC: spill below frame pointer leaving 2 words/spill-} let{off_w = 1 + (off `div` 4); - sz = case regClass vreg of { - RcInteger -> W; - RcFloat -> F; - RcDouble -> DF}} - in ST sz dyn (fpRel (- off_w)) + sz = case regClass reg of { + RcInteger -> I32; + RcFloat -> F32; + RcDouble -> F64}} + in ST sz reg (fpRel (- off_w)) #endif #ifdef powerpc_TARGET_ARCH let sz = case regClass reg of @@ -763,11 +782,11 @@ mkLoadInstr reg delta slot #endif #if sparc_TARGET_ARCH let{off_w = 1 + (off `div` 4); - sz = case regClass vreg of { - RcInteger -> W; - RcFloat -> F; - RcDouble -> DF}} - in LD sz (fpRel (- off_w)) dyn + sz = case regClass reg of { + RcInteger -> I32; + RcFloat -> F32; + RcDouble -> F64}} + in LD sz (fpRel (- off_w)) reg #endif #if powerpc_TARGET_ARCH let sz = case regClass reg of @@ -776,6 +795,42 @@ mkLoadInstr reg delta slot in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) #endif +mkRegRegMoveInstr + :: Reg + -> Reg + -> Instr +mkRegRegMoveInstr src dst +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH + = case regClass src of + RcInteger -> MOV wordRep (OpReg src) (OpReg dst) +#if i386_TARGET_ARCH + RcDouble -> GMOV src dst +#else + RcDouble -> MOV F64 (OpReg src) (OpReg dst) +#endif +#elif powerpc_TARGET_ARCH + = MR dst src +#endif + +mkBranchInstr + :: BlockId + -> [Instr] +#if alpha_TARGET_ARCH +mkBranchInstr id = [BR id] +#endif + +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH +mkBranchInstr id = [JXX ALWAYS id] +#endif + +#if sparc_TARGET_ARCH +mkBranchInstr (BlockId id) = [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP] +#endif + +#if powerpc_TARGET_ARCH +mkBranchInstr id = [BCC ALWAYS id] +#endif + spillSlotSize :: Int spillSlotSize = IF_ARCH_i386(12, 8)