-#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]
- FDIV _ src dst -> usageRM src dst
-#endif
-
- FETCHGOT reg -> mkRU [] [reg]
- FETCHPC reg -> mkRU [] [reg]
-
- COMMENT _ -> noUsage
- DELTA _ -> noUsage
- SPILL reg _ -> mkRU [reg] []
- RELOAD _ reg -> mkRU [] [reg]
-
- _other -> panic "regUsage: unrecognised instr"
-
- where
- -- 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) = mkRUR (use_R op ++ use_EA ea)
- usageRW _ _ = panic "X86.RegInfo.usageRW: no match"
-
- -- 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) = mkRUR (use_R op ++ use_EA ea)
- usageRM _ _ = panic "X86.RegInfo.usageRM: no match"
-
- -- 1 operand form; operand Modified
- usageM :: Operand -> RegUsage
- usageM (OpReg reg) = mkRU [reg] [reg]
- usageM (OpAddr ea) = mkRUR (use_EA ea)
- usageM _ = panic "X86.RegInfo.usageM: no match"
-
- -- Registers defd when an operand is written.
- def_W (OpReg reg) = [reg]
- def_W (OpAddr _ ) = []
- def_W _ = panic "X86.RegInfo.def_W: no match"
-
- -- Registers used when an operand is read.
- use_R (OpReg reg) = [reg]
- use_R (OpImm _) = []
- use_R (OpAddr ea) = use_EA ea
-
- -- Registers used to compute an effective address.
- 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
-
-interesting :: Reg -> Bool
-interesting (VirtualRegI _) = True
-interesting (VirtualRegHi _) = True
-interesting (VirtualRegF _) = True
-interesting (VirtualRegD _) = True
-interesting (RealReg i) = isFastTrue (freeReg i)
-
-
-
-
--- -----------------------------------------------------------------------------
--- 'patchRegs' function
-
--- 'patchRegs' takes an instruction and applies the given mapping to
--- all the register references.
-
-patchRegs :: Instr -> (Reg -> Reg) -> Instr
-patchRegs instr env = case instr of
- MOV sz src dst -> patch2 (MOV sz) src dst
- MOVZxL sz src dst -> patch2 (MOVZxL sz) src dst
- MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst
- LEA sz src dst -> patch2 (LEA sz) src dst
- ADD sz src dst -> patch2 (ADD 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
- 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
- AND sz src dst -> patch2 (AND sz) src dst
- OR sz src dst -> patch2 (OR sz) src dst
- XOR sz src dst -> patch2 (XOR sz) src dst
- NOT sz op -> patch1 (NOT sz) op
- NEGI sz op -> patch1 (NEGI sz) op
- SHL sz imm dst -> patch1 (SHL sz imm) dst
- SAR sz imm dst -> patch1 (SAR sz imm) dst
- SHR sz imm dst -> patch1 (SHR sz imm) dst
- BT sz imm src -> patch1 (BT sz imm) src
- TEST sz src dst -> patch2 (TEST sz) src dst
- CMP sz src dst -> patch2 (CMP sz) src dst
- PUSH sz op -> patch1 (PUSH sz) op
- 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
-
-#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)
-
- GLDZ dst -> GLDZ (env dst)
- GLD1 dst -> GLD1 (env dst)
-
- GFTOI src dst -> GFTOI (env src) (env dst)
- GDTOI src dst -> GDTOI (env src) (env dst)
-
- GITOF src dst -> GITOF (env src) (env dst)
- GITOD src dst -> GITOD (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)
- GDIV sz s1 s2 dst -> GDIV sz (env s1) (env s2) (env dst)
-
- GCMP sz src1 src2 -> GCMP sz (env src1) (env src2)
- GABS sz src dst -> GABS sz (env src) (env dst)
- GNEG sz src dst -> GNEG sz (env src) (env dst)
- GSQRT sz src dst -> GSQRT sz (env src) (env dst)
- 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)
- FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst)
-#endif
-
- CALL (Left _) _ -> 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
- 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"
-
- where
- patch1 insn op = insn $! patchOp op
- patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
-
- patchOp (OpReg reg) = OpReg $! env reg
- patchOp (OpImm imm) = OpImm imm
- patchOp (OpAddr ea) = OpAddr $! lookupAddr ea
-
- lookupAddr (ImmAddr imm off) = ImmAddr imm off
- lookupAddr (AddrBaseIndex base index disp)
- = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
- where
- lookupBase EABaseNone = EABaseNone
- lookupBase EABaseRip = EABaseRip
- lookupBase (EABaseReg r) = EABaseReg (env r)
-
- lookupIndex EAIndexNone = EAIndexNone
- lookupIndex (EAIndex r i) = EAIndex (env r) i
-
-
--- -----------------------------------------------------------------------------
--- Determine the possible destinations from the current instruction.
-
--- (we always assume that the next instruction is also a valid destination;
--- if this isn't the case then the jump should be at the end of the basic
--- block).
-
-jumpDests :: Instr -> [BlockId] -> [BlockId]
-jumpDests insn acc
- = case insn of
- JXX _ id -> id : acc
- JMP_TBL _ ids -> ids ++ acc
- _ -> acc
-
-
-isJumpish :: Instr -> Bool
-isJumpish instr
- = case instr of
- JMP{} -> True
- JXX{} -> True
- JXX_GBL{} -> True
- JMP_TBL{} -> True
- CALL{} -> True
- _ -> False
-
--- | Change the destination of this jump instruction
--- Used in joinToTargets in the linear allocator, when emitting fixup code
--- for join points.
-patchJump :: Instr -> BlockId -> BlockId -> Instr
-patchJump insn old new
- = case insn of
- JXX cc id | id == old -> JXX cc new
- JMP_TBL _ _ -> error "Cannot patch JMP_TBL"
- _other -> insn
-
-
--- -----------------------------------------------------------------------------
--- Detecting reg->reg moves
-
--- The register allocator attempts to eliminate reg->reg moves whenever it can,
--- by assigning the src and dest temporaries to the same real register.
-
-isRegRegMove :: Instr -> Maybe (Reg,Reg)
-isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
-isRegRegMove _ = Nothing