X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FnativeGen%2FRegAllocInfo.hs;h=9b60fb9d60956a5045f76b0421e803864cff53e4;hb=0168c633a9d209e978528f059193d19cdb5e6740;hp=2c3ab6b31413a5ce8a0e173d13bf86033fcda1c7;hpb=e4c8d2b11b4be71885532cb14434511b6c47866c;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index 2c3ab6b..9b60fb9 100644 --- a/compiler/nativeGen/RegAllocInfo.hs +++ b/compiler/nativeGen/RegAllocInfo.hs @@ -17,6 +17,8 @@ module RegAllocInfo ( patchJump, isRegRegMove, + JumpDest, canShortcut, shortcutJump, shortcutStatic, + maxSpillSlots, mkSpillInstr, mkLoadInstr, @@ -26,7 +28,8 @@ module RegAllocInfo ( #include "HsVersions.h" -import Cmm ( BlockId ) +import Cmm +import CLabel import MachOp ( MachRep(..), wordRep ) import MachInstrs import MachRegs @@ -66,6 +69,8 @@ interesting (RealReg i) = isFastTrue (freeReg i) #if alpha_TARGET_ARCH 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 @@ -172,6 +177,7 @@ regUsage instr = case instr of CMP sz src dst -> mkRUR (use_R src ++ use_R dst) SETCC cond op -> mkRU [] (def_W op) JXX cond lbl -> mkRU [] [] + JXX_GBL cond lbl -> mkRU [] [] JMP op -> mkRUR (use_R op) JMP_TBL op ids -> mkRUR (use_R op) CALL (Left imm) params -> mkRU params callClobberedRegs @@ -210,8 +216,8 @@ regUsage instr = case instr of #if x86_64_TARGET_ARCH CVTSS2SD src dst -> mkRU [src] [dst] CVTSD2SS src dst -> mkRU [src] [dst] - CVTSS2SI src dst -> mkRU (use_R src) [dst] - CVTSD2SI src dst -> mkRU (use_R src) [dst] + CVTTSS2SIQ src dst -> mkRU (use_R src) [dst] + CVTTSD2SIQ src dst -> mkRU (use_R src) [dst] CVTSI2SS src dst -> mkRU (use_R src) [dst] CVTSI2SD src dst -> mkRU (use_R src) [dst] FDIV sz src dst -> usageRM src dst @@ -222,6 +228,8 @@ regUsage instr = case instr of COMMENT _ -> noUsage DELTA _ -> noUsage + SPILL reg slot -> mkRU [reg] [] + RELOAD slot reg -> mkRU [] [reg] _other -> panic "regUsage: unrecognised instr" @@ -271,6 +279,9 @@ regUsage instr = case instr of #if sparc_TARGET_ARCH regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) + LD sz addr reg -> usage (regAddr addr, [reg]) ST sz reg addr -> usage (reg : regAddr addr, []) ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) @@ -323,6 +334,9 @@ regUsage instr = case instr of #if powerpc_TARGET_ARCH 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, []) @@ -417,6 +431,45 @@ patchJump insn old new #endif _other -> insn +data JumpDest = DestBlockId BlockId | DestImm Imm + +canShortcut :: Instr -> Maybe JumpDest +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH +canShortcut (JXX ALWAYS id) = Just (DestBlockId id) +canShortcut (JMP (OpImm imm)) = Just (DestImm imm) +#endif +canShortcut _ = Nothing + +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH +shortcutJump fn insn@(JXX cc id) = + case fn id of + Nothing -> insn + Just (DestBlockId id') -> shortcutJump fn (JXX cc id') + Just (DestImm imm) -> shortcutJump fn (JXX_GBL cc imm) +#endif +shortcutJump fn other = other + +-- Here because it knows about JumpDest +shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic +shortcutStatic fn (CmmStaticLit (CmmLabel lab)) + | Just uq <- maybeAsmTemp lab + = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq))) +shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) + | Just uq <- maybeAsmTemp lbl1 + = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId 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 fn other_static + = other_static + +shortBlockId fn blockid@(BlockId uq) = + case fn blockid of + Nothing -> mkAsmTempLabel uq + Just (DestBlockId blockid') -> shortBlockId fn blockid' + Just (DestImm (ImmCLbl lbl)) -> lbl + _other -> panic "shortBlockId" + -- ----------------------------------------------------------------------------- -- 'patchRegs' function @@ -428,6 +481,8 @@ patchRegs :: Instr -> (Reg -> Reg) -> Instr #if alpha_TARGET_ARCH 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) @@ -545,8 +600,8 @@ patchRegs instr env = case instr of #if x86_64_TARGET_ARCH CVTSS2SD src dst -> CVTSS2SD (env src) (env dst) CVTSD2SS src dst -> CVTSD2SS (env src) (env dst) - CVTSS2SI src dst -> CVTSS2SI (patchOp src) (env dst) - CVTSD2SI src dst -> CVTSD2SI (patchOp src) (env dst) + CVTTSS2SIQ src dst -> CVTTSS2SIQ (patchOp src) (env dst) + CVTTSD2SIQ src dst -> CVTTSD2SIQ (patchOp src) (env dst) CVTSI2SS src dst -> CVTSI2SS (patchOp src) (env dst) CVTSI2SD src dst -> CVTSI2SD (patchOp src) (env dst) FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) @@ -561,7 +616,11 @@ patchRegs instr env = case instr of NOP -> instr COMMENT _ -> instr DELTA _ -> instr + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + JXX _ _ -> instr + JXX_GBL _ _ -> instr CLTD _ -> instr _other -> panic "patchRegs: unrecognised instr" @@ -590,6 +649,8 @@ patchRegs instr env = case instr of #if sparc_TARGET_ARCH patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) LD sz addr reg -> LD sz (fixAddr addr) (env reg) ST sz reg addr -> ST sz (env reg) (fixAddr addr) ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2) @@ -633,6 +694,9 @@ patchRegs instr env = case instr of #if powerpc_TARGET_ARCH 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) @@ -716,8 +780,8 @@ mkSpillInstr -> Int -- spill slot to use -> Instr mkSpillInstr reg delta slot - = ASSERT(isRealReg reg) - let + -- = ASSERT(isRealReg reg) -- BUGS: used for graph coloring: is this ok? + = let off = spillSlotToOffset slot in #ifdef alpha_TARGET_ARCH @@ -761,8 +825,8 @@ mkLoadInstr -> Int -- spill slot to use -> Instr mkLoadInstr reg delta slot - = ASSERT(isRealReg reg) - let + -- = ASSERT(isRealReg reg) -- BUGS: used for graph coloring: is this ok? + = let off = spillSlotToOffset slot in #if alpha_TARGET_ARCH @@ -847,4 +911,5 @@ spillSlotToOffset slot = 64 + spillSlotSize * slot | otherwise = pprPanic "spillSlotToOffset:" - (text "invalid spill location: " <> int slot) + ( text "invalid spill location: " <> int slot + $$ text "maxSpillSlots: " <> int maxSpillSlots)