X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FInstr.hs;h=b9c851a859019d2dd09fe5122645927cc8ae91b4;hb=e5d8b4d0c6dd20a51597517208cbd4b0cc50c7de;hp=b9cdf7f991b43f0afe6f64fe2a93f46a5c964209;hpb=62db6241c578f2b02e266b4dd0b535e0f59950bf;p=ghc-hetmet.git diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index b9cdf7f..b9c851a 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -21,7 +21,7 @@ import Reg import TargetReg import BlockId -import Cmm +import OldCmm import FastString import FastBool import Outputable @@ -228,6 +228,8 @@ data Instr | GITOF Reg Reg -- src(intreg), dst(fpreg) | GITOD Reg Reg -- src(intreg), dst(fpreg) + | GDTOF Reg Reg -- src(fpreg), dst(fpreg) + | GADD Size Reg Reg Reg -- src1, src2, dst | GDIV Size Reg Reg Reg -- src1, src2, dst | GSUB Size Reg Reg Reg -- src1, src2, dst @@ -287,7 +289,11 @@ data Instr | JMP Operand | JXX Cond BlockId -- includes unconditional branches | JXX_GBL Cond Imm -- non-local version of JXX - | JMP_TBL Operand [BlockId] -- table jump + -- Table jump + | JMP_TBL Operand -- Address to jump to + [Maybe BlockId] -- Blocks in the jump table + Section -- Data section jump table should be put in + CLabel -- Label of jump table | CALL (Either Imm Reg) [Reg] -- Other things. @@ -348,7 +354,7 @@ x86_regUsageOfInstr instr JXX _ _ -> mkRU [] [] JXX_GBL _ _ -> mkRU [] [] JMP op -> mkRUR (use_R op) - JMP_TBL op _ -> mkRUR (use_R op) + JMP_TBL op _ _ _ -> mkRUR (use_R op) CALL (Left _) params -> mkRU params callClobberedRegs CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs CLTD _ -> mkRU [eax] [edx] @@ -367,6 +373,8 @@ x86_regUsageOfInstr instr GITOF src dst -> mkRU [src] [dst] GITOD src dst -> mkRU [src] [dst] + GDTOF src dst -> mkRU [src] [dst] + GADD _ s1 s2 dst -> mkRU [s1,s2] [dst] GSUB _ s1 s2 dst -> mkRU [s1,s2] [dst] GMUL _ s1 s2 dst -> mkRU [s1,s2] [dst] @@ -478,7 +486,7 @@ x86_patchRegsOfInstr instr env POP sz op -> patch1 (POP sz) op SETCC cond op -> patch1 (SETCC cond) op JMP op -> patch1 JMP op - JMP_TBL op ids -> patch1 JMP_TBL op $ ids + JMP_TBL op ids s lbl-> JMP_TBL (patchOp op) ids s lbl GMOV src dst -> GMOV (env src) (env dst) GLD sz src dst -> GLD sz (lookupAddr src) (env dst) @@ -493,6 +501,8 @@ x86_patchRegsOfInstr instr env GITOF src dst -> GITOF (env src) (env dst) GITOD src dst -> GITOD (env src) (env dst) + GDTOF src dst -> GDTOF (env src) (env dst) + GADD sz s1 s2 dst -> GADD sz (env s1) (env s2) (env dst) GSUB sz s1 s2 dst -> GSUB sz (env s1) (env s2) (env dst) GMUL sz s1 s2 dst -> GMUL sz (env s1) (env s2) (env dst) @@ -573,7 +583,7 @@ x86_jumpDestsOfInstr x86_jumpDestsOfInstr insn = case insn of JXX _ id -> [id] - JMP_TBL _ ids -> ids + JMP_TBL _ ids _ _ -> [id | Just id <- ids] _ -> [] @@ -583,7 +593,8 @@ x86_patchJumpInstr x86_patchJumpInstr insn patchF = case insn of JXX cc id -> JXX cc (patchF id) - JMP_TBL _ _ -> error "Cannot patch JMP_TBL" + JMP_TBL op ids section lbl + -> JMP_TBL op (map (fmap patchF) ids) section lbl _ -> insn @@ -735,6 +746,7 @@ i386_insert_ffrees blocks where p insn r = case insn of CALL _ _ -> GFREE : insn : r JMP _ -> GFREE : insn : r + JXX_GBL _ _ -> panic "i386_insert_ffrees: cannot handle JXX_GBL" _ -> insn : r -- if you ever add a new FP insn to the fake x86 FP insn set, @@ -749,8 +761,9 @@ is_G_instr instr GLD1{} -> True GFTOI{} -> True GDTOI{} -> True - GITOF{} -> True - GITOD{} -> True + GITOF{} -> True + GITOD{} -> True + GDTOF{} -> True GADD{} -> True GDIV{} -> True GSUB{} -> True @@ -768,6 +781,9 @@ is_G_instr instr data JumpDest = DestBlockId BlockId | DestImm Imm +getJumpDestBlockId :: JumpDest -> Maybe BlockId +getJumpDestBlockId (DestBlockId bid) = Just bid +getJumpDestBlockId _ = Nothing canShortcut :: Instr -> Maybe JumpDest canShortcut (JXX ALWAYS id) = Just (DestBlockId id) @@ -778,24 +794,24 @@ 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 +shortcutJump fn insn = shortcutJump' fn (setEmpty :: BlockSet) insn where shortcutJump' fn seen insn@(JXX cc id) = - if elemBlockSet id seen then insn + if setMember 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 + where seen' = setInsert id seen 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))) + = CmmStaticLit (CmmLabel (shortBlockId fn emptyUniqSet (mkBlockId uq))) shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) | Just uq <- maybeAsmTemp lbl1 - = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn emptyUniqSet (BlockId uq)) lbl2 off) + = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn emptyUniqSet (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. @@ -808,10 +824,11 @@ shortBlockId -> BlockId -> CLabel -shortBlockId fn seen blockid@(BlockId uq) = +shortBlockId fn seen blockid = 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" + where uq = getUnique blockid