regUsage,
patchRegs,
jumpDests,
+ patchJump,
isRegRegMove,
maxSpillSlots,
mkSpillInstr,
mkLoadInstr,
+ mkRegRegMoveInstr,
+ mkBranchInstr
) where
#include "HsVersions.h"
import Cmm ( BlockId )
-#if powerpc_TARGET_ARCH || i386_TARGET_ARCH
-import MachOp ( MachRep(..) )
-#endif
+import MachOp ( MachRep(..), wordRep )
import MachInstrs
import MachRegs
import Outputable
#endif /* alpha_TARGET_ARCH */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if i386_TARGET_ARCH
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
regUsage instr = case instr of
MOV sz src dst -> usageRW src dst
ADC sz src dst -> usageRM src dst
SUB sz src dst -> usageRM src dst
IMUL sz src dst -> usageRM src dst
- IMUL64 sd1 sd2 -> mkRU [sd1,sd2] [sd1,sd2]
+ IMUL2 sz src -> mkRU (eax:use_R src) [eax,edx]
MUL sz src dst -> usageRM src dst
DIV sz op -> mkRU (eax:edx:use_R op) [eax,edx]
IDIV sz op -> mkRU (eax:edx:use_R op) [eax,edx]
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) []
- CALL (Left imm) -> mkRU [] callClobberedRegs
- CALL (Right reg) -> mkRU [reg] callClobberedRegs
- CLTD -> mkRU [eax] [edx]
+ 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]
NOP -> mkRU [] []
+#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]
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]
GSIN sz src dst -> mkRU [src] [dst]
GCOS sz src dst -> mkRU [src] [dst]
GTAN sz src dst -> mkRU [src] [dst]
+#endif
+
+#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]
+ CVTSI2SS src dst -> mkRU (use_R src) [dst]
+ CVTSI2SD src dst -> mkRU (use_R src) [dst]
+ FDIV sz src dst -> usageRM src dst
+#endif
+
+ FETCHGOT reg -> mkRU [] [reg]
+ FETCHPC reg -> mkRU [] [reg]
COMMENT _ -> noUsage
DELTA _ -> noUsage
_other -> panic "regUsage: unrecognised instr"
where
+#if x86_64_TARGET_ARCH
+ -- call parameters: include %eax, because it is used
+ -- to pass the number of SSE reg arguments to varargs fns.
+ params = eax : allArgRegs ++ allFPArgRegs
+#endif
+
-- 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]
use_R (OpAddr ea) = use_EA ea
-- Registers used to compute an effective address.
- use_EA (ImmAddr _ _) = []
- use_EA (AddrBaseIndex Nothing Nothing _) = []
- use_EA (AddrBaseIndex (Just b) Nothing _) = [b]
- use_EA (AddrBaseIndex Nothing (Just (i,_)) _) = [i]
- use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i]
-
- mkRU src dst = RU (filter interesting src)
- (filter interesting dst)
-
-#endif /* i386_TARGET_ARCH */
+ use_EA (ImmAddr _ _) = []
+ use_EA (AddrBaseIndex base index _) =
+ use_base base $! use_index index
+ where use_base (EABaseReg r) x = r : x
+ use_base _ x = x
+ use_index EAIndexNone = []
+ use_index (EAIndex i _) = [i]
+
+ 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 */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if sparc_TARGET_ARCH
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)
_ -> 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]
FCTIWZ r1 r2 -> usage ([r2], [r1])
FRSP r1 r2 -> usage ([r2], [r1])
MFCR reg -> usage ([], [reg])
+ MFLR reg -> usage ([], [reg])
+ FETCHPC reg -> usage ([], [reg])
_ -> noUsage
where
usage (src, dst) = RU (filter interesting src)
jumpDests :: Instr -> [BlockId] -> [BlockId]
jumpDests insn acc
= case insn of
-#if i386_TARGET_ARCH
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
JXX _ id -> id : acc
JMP_TBL _ ids -> ids ++ acc
#elif powerpc_TARGET_ARCH
#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
#endif /* alpha_TARGET_ARCH */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if i386_TARGET_ARCH
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
patchRegs instr env = case instr of
MOV sz src dst -> patch2 (MOV sz) src dst
ADC sz src dst -> patch2 (ADC sz) src dst
SUB sz src dst -> patch2 (SUB sz) src dst
IMUL sz src dst -> patch2 (IMUL sz) src dst
- IMUL64 sd1 sd2 -> IMUL64 (env sd1) (env sd2)
+ IMUL2 sz src -> patch1 (IMUL2 sz) src
MUL sz src dst -> patch2 (MUL sz) src dst
IDIV sz op -> patch1 (IDIV sz) op
DIV sz op -> patch1 (DIV sz) op
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)
GSIN sz src dst -> GSIN sz (env src) (env dst)
GCOS sz src dst -> GCOS sz (env src) (env dst)
GTAN sz src dst -> GTAN sz (env src) (env dst)
+#endif
- CALL (Left imm) -> instr
- CALL (Right reg) -> CALL (Right (env reg))
-
+#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)
+ 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)
+#endif
+
+ CALL (Left imm) _ -> instr
+ 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
JXX _ _ -> instr
- CLTD -> instr
+ CLTD _ -> instr
_other -> panic "patchRegs: unrecognised instr"
patch1 insn op = insn $! patchOp op
patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
- patchOp (OpReg reg) = OpReg (env reg)
+ patchOp (OpReg reg) = OpReg $! env reg
patchOp (OpImm imm) = OpImm imm
- patchOp (OpAddr ea) = OpAddr (lookupAddr ea)
+ patchOp (OpAddr ea) = OpAddr $! lookupAddr ea
lookupAddr (ImmAddr imm off) = ImmAddr imm off
lookupAddr (AddrBaseIndex base index disp)
- = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
+ = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
where
- lookupBase Nothing = Nothing
- lookupBase (Just r) = Just (env r)
+ lookupBase EABaseNone = EABaseNone
+ lookupBase EABaseRip = EABaseRip
+ lookupBase (EABaseReg r) = EABaseReg (env r)
- lookupIndex Nothing = Nothing
- lookupIndex (Just (r,i)) = Just (env r, i)
+ lookupIndex EAIndexNone = EAIndexNone
+ lookupIndex (EAIndex r i) = EAIndex (env r) i
-#endif /* i386_TARGET_ARCH */
+#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH*/
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if sparc_TARGET_ARCH
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
FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2)
FRSP r1 r2 -> FRSP (env r1) (env r2)
MFCR reg -> MFCR (env reg)
+ MFLR reg -> MFLR (env reg)
+ FETCHPC reg -> FETCHPC (env reg)
_ -> instr
where
fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
-- by assigning the src and dest temporaries to the same real register.
isRegRegMove :: Instr -> Maybe (Reg,Reg)
-#ifdef i386_TARGET_ARCH
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-- TMP:
isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
#elif powerpc_TARGET_ARCH
RcInteger -> MOV I32 (OpReg reg) (OpAddr (spRel off_w))
_ -> GST F80 reg (spRel off_w) {- RcFloat/RcDouble -}
#endif
+#ifdef x86_64_TARGET_ARCH
+ let off_w = (off-delta) `div` 8
+ in case regClass reg of
+ RcInteger -> MOV I64 (OpReg reg) (OpAddr (spRel off_w))
+ RcDouble -> MOV F64 (OpReg reg) (OpAddr (spRel off_w))
+ -- ToDo: will it work to always spill as a double?
+ -- does that cause a stall if the data was a float?
+#endif
#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
let
off = spillSlotToOffset slot
in
-#ifdef alpha_TARGET_ARCH
+#if alpha_TARGET_ARCH
LD sz dyn (spRel (- (off `div` 8)))
#endif
-#ifdef i386_TARGET_ARCH
+#if i386_TARGET_ARCH
let off_w = (off-delta) `div` 4
in case regClass reg of {
RcInteger -> MOV I32 (OpAddr (spRel off_w)) (OpReg reg);
_ -> GLD F80 (spRel off_w) reg} {- RcFloat/RcDouble -}
#endif
-#ifdef sparc_TARGET_ARCH
+#if x86_64_TARGET_ARCH
+ let off_w = (off-delta) `div` 8
+ in case regClass reg of
+ RcInteger -> MOV I64 (OpAddr (spRel off_w)) (OpReg reg)
+ _ -> MOV F64 (OpAddr (spRel off_w)) (OpReg reg)
+#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
-#ifdef powerpc_TARGET_ARCH
+#if powerpc_TARGET_ARCH
let sz = case regClass reg of
RcInteger -> I32
RcDouble -> F64
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)