merge up to ghc HEAD 16-Apr-2011

[ghc-hetmet.git] / compiler / nativeGen / X86 / CodeGen.hs

diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 89a26a9..5df8f77 100644 (file)
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -47,7 +47,8 @@ import Platform
 import BasicTypes
 import BlockId
 import PprCmm          ( pprExpr )
-import Cmm
+import OldCmm
+import OldPprCmm
 import CLabel
 import ClosureInfo     ( C_SRT(..) )
 
@@ -58,6 +59,7 @@ import OrdList
 import Pretty
 import qualified Outputable as O
 import Outputable
+import Unique
 import FastString
 import FastBool                ( isFastTrue )
 import Constants       ( wORD_SIZE )
@@ -93,11 +95,10 @@ cmmTopCodeGen
        -> RawCmmTop
        -> NatM [NatCmmTop Instr]
 
-cmmTopCodeGen dynflags 
-       (CmmProc info lab params (ListGraph blocks)) = do
+cmmTopCodeGen dynflags (CmmProc info lab (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
-  let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
+  let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
       tops = proc : concat statics
       os   = platformOS $ targetPlatform dynflags
 
@@ -271,8 +272,8 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
 -- | Convert a BlockId to some CmmStatic data
 jumpTableEntry :: Maybe BlockId -> CmmStatic
 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
-jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
-    where blockLabel = mkAsmTempLabel id
+jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
+    where blockLabel = mkAsmTempLabel (getUnique blockid)
 
 
 -- -----------------------------------------------------------------------------
@@ -430,7 +431,7 @@ getRegister (CmmReg reg)
          size | not use_sse2 && isFloatSize sz = FF80
               | otherwise                      = sz
        --
-       return (Fixed sz (getRegisterReg use_sse2 reg) nilOL)
+       return (Fixed size (getRegisterReg use_sse2 reg) nilOL)
   
 
 getRegister tree@(CmmRegOff _ _) 
@@ -604,9 +605,7 @@ getRegister (CmmMachOp mop [x]) = do -- unary MachOps
         | sse2      -> coerceFP2FP W64 x
         | otherwise -> conversionNop FF80 x 
 
-      MO_FF_Conv W64 W32
-        | sse2      -> coerceFP2FP W32 x
-        | otherwise -> conversionNop FF80 x 
+      MO_FF_Conv W64 W32 -> coerceFP2FP W32 x
 
       MO_FS_Conv from to -> coerceFP2Int from to x
       MO_SF_Conv from to -> coerceInt2FP from to x
@@ -991,11 +990,11 @@ getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)])
        let off = ImmInt (-(fromInteger i))
        return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
   
-getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)])
+getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit])
   | is32BitLit lit
   -- ASSERT(rep == II32)???
   = do (x_reg, x_code) <- getSomeReg x
-       let off = ImmInt (fromInteger i)
+       let off = litToImm lit
        return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
 
 -- Turn (lit1 << n  + lit2) into  (lit2 + lit1 << n) so it will be 
@@ -1588,12 +1587,24 @@ genCCall target dest_regs args = do
             | otherwise
 #endif
             = concatOL push_codes
+       
+         -- Deallocate parameters after call for ccall;
+         -- but not for stdcall (callee does it)
+         --
+         -- We have to pop any stack padding we added
+         -- on Darwin even if we are doing stdcall, though (#5052)
+       pop_size | cconv /= StdCallConv = tot_arg_size
+                | otherwise
+#if darwin_TARGET_OS
+                 = arg_pad_size
+#else
+                 = 0
+#endif
+       
        call = callinsns `appOL`
                toOL (
-                       -- Deallocate parameters after call for ccall;
-                       -- but not for stdcall (callee does it)
-                  (if cconv == StdCallConv || tot_arg_size==0 then [] else 
-                  [ADD II32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
+                  (if pop_size==0 then [] else 
+                  [ADD II32 (OpImm (ImmInt pop_size)) (OpReg esp)])
                   ++
                   [DELTA (delta + tot_arg_size)]
                )
@@ -1926,9 +1937,9 @@ genSwitch expr ids
             
             jumpTableEntryRel Nothing
                 = CmmStaticLit (CmmInt 0 wordWidth)
-            jumpTableEntryRel (Just (BlockId id))
+            jumpTableEntryRel (Just blockid)
                 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                where blockLabel = mkAsmTempLabel id
+                where blockLabel = mkAsmTempLabel (getUnique blockid)
 
             op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
                                        (EAIndex reg wORD_SIZE) (ImmInt 0))
@@ -2256,12 +2267,14 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87
 --------------------------------------------------------------------------------
 coerceFP2FP :: Width -> CmmExpr -> NatM Register
 coerceFP2FP to x = do
+  use_sse2 <- sse2Enabled
   (x_reg, x_code) <- getSomeReg x
   let
-        opc  = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD
+        opc | use_sse2  = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD
+            | otherwise = GDTOF
         code dst = x_code `snocOL` opc x_reg dst
   -- in
-  return (Any (floatSize to) code)
+  return (Any (if use_sse2 then floatSize to else FF80) code)
 
 --------------------------------------------------------------------------------