X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FInstr.hs;h=b9c851a859019d2dd09fe5122645927cc8ae91b4;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hp=f856313e00e70464d5e5cb766752e27781591cac;hpb=335b9f366ac440259318777c4c07e4fa42fbbec6;p=ghc-hetmet.git diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index f856313..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 @@ -102,7 +102,7 @@ Hence GLDZ and GLD1. Bwahahahahahahaha! -} {- -MORE FLOATING POINT MUSINGS... +Note [x86 Floating point precision] Intel's internal floating point registers are by default 80 bit extended precision. This means that all operations done on values in @@ -141,11 +141,12 @@ This is what gcc does. Spilling at 80 bits requires taking up a full 128 bit slot (so we get alignment). We spill at 80-bits and ignore the alignment problems. -In the future, we'll use the SSE registers for floating point. This -requires a CPU that supports SSE2 (ordinary SSE only supports 32 bit -precision float ops), which means P4 or Xeon and above. Using SSE -will solve all these problems, because the SSE registers use fixed 32 -bit or 64 bit precision. +In the future [edit: now available in GHC 7.0.1, with the -msse2 +flag], we'll use the SSE registers for floating point. This requires +a CPU that supports SSE2 (ordinary SSE only supports 32 bit precision +float ops), which means P4 or Xeon and above. Using SSE will solve +all these problems, because the SSE registers use fixed 32 bit or 64 +bit precision. --SDM 1/2003 -} @@ -227,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 @@ -286,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. @@ -347,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] @@ -366,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] @@ -477,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) @@ -492,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) @@ -530,7 +541,9 @@ x86_patchRegsOfInstr instr env _other -> panic "patchRegs: unrecognised instr" where + patch1 :: (Operand -> a) -> Operand -> a patch1 insn op = insn $! patchOp op + patch2 :: (Operand -> Operand -> a) -> Operand -> Operand -> a patch2 insn src dst = (insn $! patchOp src) $! patchOp dst patchOp (OpReg reg) = OpReg $! env reg @@ -570,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] _ -> [] @@ -580,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 @@ -732,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, @@ -746,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 @@ -765,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) @@ -775,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. @@ -805,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