X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FInstr.hs;h=f856313e00e70464d5e5cb766752e27781591cac;hb=335b9f366ac440259318777c4c07e4fa42fbbec6;hp=26da90778c82dca0c37c0e2a5dde6aa14496d752;hpb=20c0e6ccf28b0961d2c5f6516b57e52fa2c13b33;p=ghc-hetmet.git diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 26da907..f856313 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -18,6 +18,7 @@ import Instruction import Size import RegClass import Reg +import TargetReg import BlockId import Cmm @@ -27,7 +28,8 @@ import Outputable import Constants (rESERVED_C_STACK_BYTES) import CLabel -import Panic +import UniqSet +import Unique -- Size of a PPC memory address, in bytes. -- @@ -251,10 +253,10 @@ data Instr -- use MOV for moving (either movss or movsd (movlpd better?)) | CVTSS2SD Reg Reg -- F32 to F64 | CVTSD2SS Reg Reg -- F64 to F32 - | CVTTSS2SIQ Operand Reg -- F32 to I32/I64 (with truncation) - | CVTTSD2SIQ Operand Reg -- F64 to I32/I64 (with truncation) - | CVTSI2SS Operand Reg -- I32/I64 to F32 - | CVTSI2SD Operand Reg -- I32/I64 to F64 + | CVTTSS2SIQ Size Operand Reg -- F32 to I32/I64 (with truncation) + | CVTTSD2SIQ Size Operand Reg -- F64 to I32/I64 (with truncation) + | CVTSI2SS Size Operand Reg -- I32/I64 to F32 + | CVTSI2SD Size Operand Reg -- I32/I64 to F64 -- use ADD & SUB for arithmetic. In both cases, operands -- are Operand Reg. @@ -351,7 +353,6 @@ x86_regUsageOfInstr instr CLTD _ -> mkRU [eax] [edx] NOP -> mkRU [] [] -#if i386_TARGET_ARCH GMOV src dst -> mkRU [src] [dst] GLD _ src dst -> mkRU (use_EA src) [dst] GST _ src dst -> mkRUR (src : use_EA dst) @@ -377,17 +378,14 @@ x86_regUsageOfInstr instr GSIN _ _ _ src dst -> mkRU [src] [dst] GCOS _ _ _ src dst -> mkRU [src] [dst] GTAN _ _ _ src dst -> mkRU [src] [dst] -#endif -#if x86_64_TARGET_ARCH CVTSS2SD src dst -> mkRU [src] [dst] CVTSD2SS src dst -> mkRU [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] + 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 _ src dst -> usageRM src dst -#endif FETCHGOT reg -> mkRU [] [reg] FETCHPC reg -> mkRU [] [reg] @@ -443,12 +441,9 @@ x86_regUsageOfInstr instr dst' = filter interesting dst interesting :: Reg -> Bool -interesting (VirtualRegI _) = True -interesting (VirtualRegHi _) = True -interesting (VirtualRegF _) = True -interesting (VirtualRegD _) = True -interesting (RealReg i) = isFastTrue (freeReg i) - +interesting (RegVirtual _) = True +interesting (RegReal (RealRegSingle i)) = isFastTrue (freeReg i) +interesting (RegReal (RealRegPair{})) = panic "X86.interesting: no reg pairs on this arch" @@ -484,7 +479,6 @@ x86_patchRegsOfInstr instr env JMP op -> patch1 JMP op JMP_TBL op ids -> patch1 JMP_TBL op $ ids -#if i386_TARGET_ARCH GMOV src dst -> GMOV (env src) (env dst) GLD sz src dst -> GLD sz (lookupAddr src) (env dst) GST sz src dst -> GST sz (env src) (lookupAddr dst) @@ -510,17 +504,14 @@ x86_patchRegsOfInstr instr env GSIN sz l1 l2 src dst -> GSIN sz l1 l2 (env src) (env dst) GCOS sz l1 l2 src dst -> GCOS sz l1 l2 (env src) (env dst) GTAN sz l1 l2 src dst -> GTAN sz l1 l2 (env src) (env dst) -#endif -#if x86_64_TARGET_ARCH CVTSS2SD src dst -> CVTSS2SD (env src) (env dst) CVTSD2SS src dst -> CVTSD2SS (env 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) + CVTTSS2SIQ sz src dst -> CVTTSS2SIQ sz (patchOp src) (env dst) + CVTTSD2SIQ sz src dst -> CVTTSD2SIQ sz (patchOp src) (env dst) + CVTSI2SS sz src dst -> CVTSI2SS sz (patchOp src) (env dst) + CVTSI2SD sz src dst -> CVTSI2SD sz (patchOp src) (env dst) FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) -#endif CALL (Left _) _ -> instr CALL (Right reg) p -> CALL (Right (env reg)) p @@ -603,30 +594,16 @@ x86_mkSpillInstr -> Int -- spill slot to use -> Instr -#if i386_TARGET_ARCH -x86_mkSpillInstr reg delta slot - = let off = spillSlotToOffset slot - in - let off_w = (off-delta) `div` 4 - in case regClass reg of - RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w)) - _ -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -} - -#elif x86_64_TARGET_ARCH x86_mkSpillInstr reg delta slot = let off = spillSlotToOffset slot in - let off_w = (off-delta) `div` 8 - in case regClass reg of - RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w)) - RcDouble -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w)) + let off_w = (off-delta) `div` IF_ARCH_i386(4,8) + in case targetClassOfReg reg of + RcInteger -> MOV IF_ARCH_i386(II32,II64) + (OpReg reg) (OpAddr (spRel off_w)) + RcDouble -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -} + RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w)) _ -> panic "X86.mkSpillInstr: no match" - -- ToDo: will it work to always spill as a double? - -- does that cause a stall if the data was a float? -#else -x86_mkSpillInstr _ _ _ - = panic "X86.RegInfo.mkSpillInstr: not defined for this architecture." -#endif -- | Make a spill reload instruction. @@ -636,26 +613,16 @@ x86_mkLoadInstr -> Int -- spill slot to use -> Instr -#if i386_TARGET_ARCH -x86_mkLoadInstr reg delta slot - = let off = spillSlotToOffset slot - in - let off_w = (off-delta) `div` 4 - in case regClass reg of { - RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg); - _ -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -} -#elif x86_64_TARGET_ARCH x86_mkLoadInstr reg delta slot = let off = spillSlotToOffset slot in - let off_w = (off-delta) `div` 8 - in case regClass reg of - RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg) - _ -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg) -#else -x86_mkLoadInstr _ _ _ - = panic "X86.RegInfo.mkLoadInstr: not defined for this architecture." -#endif + let off_w = (off-delta) `div` IF_ARCH_i386(4,8) + in case targetClassOfReg reg of + RcInteger -> MOV IF_ARCH_i386(II32,II64) + (OpAddr (spRel off_w)) (OpReg reg) + RcDouble -> GLD FF80 (spRel off_w) reg {- RcFloat/RcDouble -} + RcDoubleSSE -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg) + _ -> panic "X86.x86_mkLoadInstr" spillSlotSize :: Int spillSlotSize = IF_ARCH_i386(12, 8) @@ -713,17 +680,15 @@ x86_mkRegRegMoveInstr -> Instr x86_mkRegRegMoveInstr src dst - = case regClass src of + = case targetClassOfReg src of #if i386_TARGET_ARCH RcInteger -> MOV II32 (OpReg src) (OpReg dst) - RcDouble -> GMOV src dst - RcFloat -> panic "X86.RegInfo.mkRegRegMoveInstr: no match" #else RcInteger -> MOV II64 (OpReg src) (OpReg dst) - RcDouble -> MOV FF64 (OpReg src) (OpReg dst) - RcFloat -> panic "X86.RegInfo.mkRegRegMoveInstr: no match" #endif - + RcDouble -> GMOV src dst + RcDoubleSSE -> MOV FF64 (OpReg src) (OpReg dst) + _ -> panic "X86.RegInfo.mkRegRegMoveInstr: no match" -- | Check whether an instruction represents a reg-reg move. -- The register allocator attempts to eliminate reg->reg moves whenever it can, @@ -796,3 +761,54 @@ is_G_instr instr GTAN{} -> True GFREE -> panic "is_G_instr: GFREE (!)" _ -> False + + +data JumpDest = DestBlockId BlockId | DestImm Imm + + +canShortcut :: Instr -> Maybe JumpDest +canShortcut (JXX ALWAYS id) = Just (DestBlockId id) +canShortcut (JMP (OpImm imm)) = Just (DestImm imm) +canShortcut _ = Nothing + + +-- This helper shortcuts a sequence of branches. +-- The blockset helps avoid following cycles. +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +shortcutJump fn insn = shortcutJump' fn emptyBlockSet insn + where shortcutJump' fn seen insn@(JXX cc id) = + if elemBlockSet id seen then insn + else case fn id of + Nothing -> insn + Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id') + Just (DestImm imm) -> shortcutJump' fn seen' (JXX_GBL cc imm) + where seen' = extendBlockSet seen id + shortcutJump' _ _ 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 emptyUniqSet (BlockId uq))) +shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) + | Just uq <- maybeAsmTemp lbl1 + = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn emptyUniqSet (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 _ other_static + = other_static + +shortBlockId + :: (BlockId -> Maybe JumpDest) + -> UniqSet Unique + -> BlockId + -> CLabel + +shortBlockId fn seen blockid@(BlockId uq) = + case (elementOfUniqSet uq seen, fn blockid) of + (True, _) -> mkAsmTempLabel uq + (_, Nothing) -> mkAsmTempLabel uq + (_, Just (DestBlockId blockid')) -> shortBlockId fn (addOneToUniqSet seen uq) blockid' + (_, Just (DestImm (ImmCLbl lbl))) -> lbl + (_, _other) -> panic "shortBlockId"