X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=9dbe316d16631c4c623aca28dc522c677a7e690b;hb=08560cf0e3a2a1928650ca5d5d0bb44fbac2ea44;hp=90ce6b5bf8cca25cfb2bbe5ca2ebaa16d7ecbb96;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index 90ce6b5..9dbe316 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -42,13 +42,13 @@ import Constants	( wORD_SIZE )
 
 #ifdef DEBUG
 import Outputable	( assertPanic )
-import TRACE		( trace )
+import Debug.Trace	( trace )
 #endif
 
 import Control.Monad	( mapAndUnzipM )
-import Maybe		( fromJust )
-import DATA_BITS
-import DATA_WORD
+import Data.Maybe	( fromJust )
+import Data.Bits
+import Data.Word
 
 -- -----------------------------------------------------------------------------
 -- Top-level of the instruction selector
@@ -497,6 +497,31 @@ getRegister (CmmReg reg)
 getRegister tree@(CmmRegOff _ _) 
   = getRegister (mangleIndexTree tree)
 
+
+#if WORD_SIZE_IN_BITS==32
+    -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
+    -- TO_W_(x), TO_W_(x >> 32)
+
+getRegister (CmmMachOp (MO_U_Conv I64 I32)
+             [CmmMachOp (MO_U_Shr I64) [x,CmmLit (CmmInt 32 _)]]) = do
+  ChildCode64 code rlo <- iselExpr64 x
+  return $ Fixed I32 (getHiVRegFromLo rlo) code
+
+getRegister (CmmMachOp (MO_S_Conv I64 I32)
+             [CmmMachOp (MO_U_Shr I64) [x,CmmLit (CmmInt 32 _)]]) = do
+  ChildCode64 code rlo <- iselExpr64 x
+  return $ Fixed I32 (getHiVRegFromLo rlo) code
+
+getRegister (CmmMachOp (MO_U_Conv I64 I32) [x]) = do
+  ChildCode64 code rlo <- iselExpr64 x
+  return $ Fixed I32 rlo code
+
+getRegister (CmmMachOp (MO_S_Conv I64 I32) [x]) = do
+  ChildCode64 code rlo <- iselExpr64 x
+  return $ Fixed I32 rlo code       
+
+#endif
+
 -- end of machine-"independent" bit; here we go on the rest...
 
 #if alpha_TARGET_ARCH
@@ -898,21 +923,19 @@ getRegister (CmmMachOp mop [x]) -- unary MachOps
       MO_Not rep   -> trivialUCode rep (NOT  rep) x
 
       -- Nop conversions
-      -- TODO: these are only nops if the arg is not a fixed register that
-      -- can't be byte-addressed.
-      MO_U_Conv I32 I8  -> conversionNop I32 x
-      MO_S_Conv I32 I8  -> conversionNop I32 x
-      MO_U_Conv I16 I8  -> conversionNop I16 x
-      MO_S_Conv I16 I8  -> conversionNop I16 x
-      MO_U_Conv I32 I16 -> conversionNop I32 x
-      MO_S_Conv I32 I16 -> conversionNop I32 x
+      MO_U_Conv I32 I8  -> toI8Reg  I32 x
+      MO_S_Conv I32 I8  -> toI8Reg  I32 x
+      MO_U_Conv I16 I8  -> toI8Reg  I16 x
+      MO_S_Conv I16 I8  -> toI8Reg  I16 x
+      MO_U_Conv I32 I16 -> toI16Reg I32 x
+      MO_S_Conv I32 I16 -> toI16Reg I32 x
 #if x86_64_TARGET_ARCH
       MO_U_Conv I64 I32 -> conversionNop I64 x
       MO_S_Conv I64 I32 -> conversionNop I64 x
-      MO_U_Conv I64 I16 -> conversionNop I64 x
-      MO_S_Conv I64 I16 -> conversionNop I64 x
-      MO_U_Conv I64 I8  -> conversionNop I64 x
-      MO_S_Conv I64 I8  -> conversionNop I64 x
+      MO_U_Conv I64 I16 -> toI16Reg I64 x
+      MO_S_Conv I64 I16 -> toI16Reg I64 x
+      MO_U_Conv I64 I8  -> toI8Reg  I64 x
+      MO_S_Conv I64 I8  -> toI8Reg  I64 x
 #endif
 
       MO_U_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
@@ -964,6 +987,18 @@ getRegister (CmmMachOp mop [x]) -- unary MachOps
 		  instr from (OpReg reg) (OpReg dst)
 	    return (Any to code)
 
+	toI8Reg new_rep expr
+            = do codefn <- getAnyReg expr
+		 return (Any new_rep codefn)
+		-- HACK: use getAnyReg to get a byte-addressable register.
+		-- If the source was a Fixed register, this will add the
+		-- mov instruction to put it into the desired destination.
+		-- We're assuming that the destination won't be a fixed
+		-- non-byte-addressable register; it won't be, because all
+		-- fixed registers are word-sized.
+
+	toI16Reg = toI8Reg -- for now
+
         conversionNop new_rep expr
             = do e_code <- getRegister expr
                  return (swizzleRegisterRep e_code new_rep)
@@ -2037,7 +2072,7 @@ getCondCode (CmmMachOp mop [x, y])
       MO_U_Lt rep -> condIntCode LU   x y
       MO_U_Le rep -> condIntCode LEU  x y
 
-      other -> pprPanic "getCondCode(x86,sparc)" (pprMachOp mop)
+      other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y]))
 
 getCondCode other =  pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
 
@@ -2899,6 +2934,10 @@ genCCall fn cconv result_regs args
 
 #if i386_TARGET_ARCH
 
+genCCall (CmmPrim MO_WriteBarrier) _ _ _ = return nilOL
+	-- write barrier compiles to no code on x86/x86-64; 
+	-- we keep it this long in order to prevent earlier optimisations.
+
 -- we only cope with a single result for foreign calls
 genCCall (CmmPrim op) [(r,_)] args vols = do
   case op of
@@ -3068,7 +3107,7 @@ outOfLineFloatOp mop res args vols
           code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
           return (code1 `appOL` code2)
   where
-	lbl = mkForeignLabel fn Nothing True
+	lbl = mkForeignLabel fn Nothing False
 
 	fn = case mop of
 	      MO_F32_Sqrt  -> FSLIT("sqrtf")
@@ -3109,6 +3148,10 @@ outOfLineFloatOp mop res args vols
 
 #if x86_64_TARGET_ARCH
 
+genCCall (CmmPrim MO_WriteBarrier) _ _ _ = return nilOL
+	-- write barrier compiles to no code on x86/x86-64; 
+	-- we keep it this long in order to prevent earlier optimisations.
+
 genCCall (CmmPrim op) [(r,_)] args vols = 
   outOfLineFloatOp op r args vols