import Data.Maybe ( fromJust )
import Data.Bits
import Data.Word
+import Data.Int
-- -----------------------------------------------------------------------------
-- Top-level of the instruction selector
-- in
return (ChildCode64 code rlo)
+iselExpr64 (CmmMachOp (MO_U_Conv _ I64) [expr]) = do
+ fn <- getAnyReg expr
+ r_dst_lo <- getNewRegNat I32
+ let r_dst_hi = getHiVRegFromLo r_dst_lo
+ code = fn r_dst_lo
+ return (
+ ChildCode64 (code `snocOL`
+ MOV I32 (OpImm (ImmInt 0)) (OpReg r_dst_hi))
+ r_dst_lo
+ )
+
iselExpr64 expr
= pprPanic "iselExpr64(i386)" (ppr expr)
-- in
return (Any rep code)
- {- Case2: shift length is complex (non-immediate) -}
+ {- Case2: shift length is complex (non-immediate)
+ * y must go in %ecx.
+ * we cannot do y first *and* put its result in %ecx, because
+ %ecx might be clobbered by x.
+ * if we do y second, then x cannot be
+ in a clobbered reg. Also, we cannot clobber x's reg
+ with the instruction itself.
+ * so we can either:
+ - do y first, put its result in a fresh tmp, then copy it to %ecx later
+ - do y second and put its result into %ecx. x gets placed in a fresh
+ tmp. This is likely to be better, becuase the reg alloc can
+ eliminate this reg->reg move here (it won't eliminate the other one,
+ because the move is into the fixed %ecx).
+ -}
shift_code rep instr x y{-amount-} = do
- (x_reg, x_code) <- getNonClobberedReg x
+ x_code <- getAnyReg x
+ tmp <- getNewRegNat rep
y_code <- getAnyReg y
let
- code = x_code `appOL`
+ code = x_code tmp `appOL`
y_code ecx `snocOL`
- instr (OpReg ecx) (OpReg x_reg)
+ instr (OpReg ecx) (OpReg tmp)
-- in
- return (Fixed rep x_reg code)
+ return (Fixed rep tmp code)
--------------------
add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _)
[y, CmmLit (CmmInt shift _)]])
| shift == 0 || shift == 1 || shift == 2 || shift == 3
- = do (x_reg, x_code) <- getNonClobberedReg x
- -- x must be in a temp, because it has to stay live over y_code
- -- we could compre x_reg and y_reg and do something better here...
- (y_reg, y_code) <- getSomeReg y
- let
- code = x_code `appOL` y_code
- base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
- return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt 0))
- code)
+ = x86_complex_amode x y shift 0
+
+getAmode (CmmMachOp (MO_Add rep)
+ [x, CmmMachOp (MO_Add _)
+ [CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)],
+ CmmLit (CmmInt offset _)]])
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
+ && not (is64BitInteger offset)
+ = x86_complex_amode x y shift offset
+
+getAmode (CmmMachOp (MO_Add rep) [x,y])
+ = x86_complex_amode x y 0 0
getAmode (CmmLit lit) | not (is64BitLit lit)
= return (Amode (ImmAddr (litToImm lit) 0) nilOL)
(reg,code) <- getSomeReg expr
return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
+
+x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
+x86_complex_amode base index shift offset
+ = do (x_reg, x_code) <- getNonClobberedReg base
+ -- x must be in a temp, because it has to stay live over y_code
+ -- we could compre x_reg and y_reg and do something better here...
+ (y_reg, y_code) <- getSomeReg index
+ let
+ code = x_code `appOL` y_code
+ base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
+ return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset)))
+ code)
+
#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#endif
is64BitInteger :: Integer -> Bool
-is64BitInteger i = i > 0x7fffffff || i < -0x80000000
+is64BitInteger i = i64 > 0x7fffffff || i64 < -0x80000000
+ where i64 = fromIntegral i :: Int64
+ -- a CmmInt is intended to be truncated to the appropriate
+ -- number of bits, so here we truncate it to Int64. This is
+ -- important because e.g. -1 as a CmmInt might be either
+ -- -1 or 18446744073709551615.
-- -----------------------------------------------------------------------------
-- The 'CondCode' type: Condition codes passed up the tree.
-- yes, they really do seem to want exactly the same!
getCondCode (CmmMachOp mop [x, y])
- = ASSERT (cmmExprRep x /= I8) -- tmp, not set up to handle 8-bit comparisons
+ =
case mop of
MO_Eq F32 -> condFltCode EQQ x y
MO_Ne F32 -> condFltCode NE x y
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-- integer assignment to memory
+
+-- specific case of adding/subtracting an integer to a particular address.
+-- ToDo: catch other cases where we can use an operation directly on a memory
+-- address.
+assignMem_IntCode pk addr (CmmMachOp op [CmmLoad addr2 _,
+ CmmLit (CmmInt i _)])
+ | addr == addr2, pk /= I64 || not (is64BitInteger i),
+ Just instr <- check op
+ = do Amode amode code_addr <- getAmode addr
+ let code = code_addr `snocOL`
+ instr pk (OpImm (ImmInt (fromIntegral i))) (OpAddr amode)
+ return code
+ where
+ check (MO_Add _) = Just ADD
+ check (MO_Sub _) = Just SUB
+ check _ = Nothing
+ -- ToDo: more?
+
+-- general case
assignMem_IntCode pk addr src = do
Amode addr code_addr <- getAmode addr
(code_src, op_src) <- get_op_RI src
(arg_reg, arg_code) <- getSomeReg arg
delta <- getDeltaNat
setDeltaNat (delta-arg_size)
- let code' = code `appOL` toOL [
- MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0)),
+ let code' = code `appOL` arg_code `appOL` toOL [
SUB wordRep (OpImm (ImmInt arg_size)) (OpReg rsp) ,
- DELTA (delta-arg_size)]
+ DELTA (delta-arg_size),
+ MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0))]
push_args rest code'
| otherwise = do
-- -----------------------------------------------------------------------------
-- Coercing to/from integer/floating-point...
+-- When going to integer, we truncate (round towards 0).
+
-- @coerce(Int2FP|FP2Int)@ are more complicated integer/float
-- conversions. We have to store temporaries in memory to move
-- between the integer and the floating point register sets.
coerceFP2Int from to x = do
(x_op, x_code) <- getOperand x -- ToDo: could be a safe operand
let
- opc = case from of F32 -> CVTSS2SI; F64 -> CVTSD2SI
+ opc = case from of F32 -> CVTTSS2SIQ; F64 -> CVTTSD2SIQ
code dst = x_code `snocOL` opc x_op dst
-- in
return (Any to code) -- works even if the destination rep is <I32
projects / ghc-hetmet.git / blobdiff