X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=79c8d69678cf94dbaf612c62e9fb10f4eabdd5e0;hb=970d5b88b1554bbdd7e459dae41aab3668ae897a;hp=17ee624557357ada2fb622cb6c6f4db617ce6ab1;hpb=970cd21327e30e5b9af594884f1ac79334ed0582;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index 17ee624..79c8d69 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -49,6 +49,7 @@ import Control.Monad ( mapAndUnzipM ) import Data.Maybe ( fromJust ) import Data.Bits import Data.Word +import Data.Int -- ----------------------------------------------------------------------------- -- Top-level of the instruction selector @@ -1147,16 +1148,30 @@ getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps -- 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 @@ -1828,15 +1843,18 @@ getAmode (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _), 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) @@ -1845,6 +1863,19 @@ getAmode expr = do (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 */ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2037,7 +2068,12 @@ is64BitLit x = False #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. @@ -2359,6 +2395,25 @@ assignIntCode pk dst src #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 @@ -3306,10 +3361,10 @@ genCCall target dest_regs args vols = do (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 @@ -4522,6 +4577,8 @@ remainderCode rep div x y = 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. @@ -4607,7 +4664,7 @@ coerceFP2Int from to x = do 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