X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=3abf6a43e25e43eab51f6ea36c28a4ca32042480;hb=46b28f7bfdd535e9fe5217a1151bedfb2cc15472;hp=fca5be30e51cf768c42c5bef7fa90cbe66d618da;hpb=0180405d6407ed9adf66a1d0f6d0c69d5e77056f;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index fca5be3..3abf6a4 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -265,6 +265,17 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
    -- 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)
 
@@ -1148,16 +1159,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
@@ -1839,6 +1864,9 @@ getAmode (CmmMachOp (MO_Add rep)
   && 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)
 
@@ -2378,6 +2406,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
@@ -3325,10 +3372,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
@@ -4541,6 +4588,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.
@@ -4626,7 +4675,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 <I32