X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmOpt.hs;h=2dced6ae9cb0d44d8e2805fcdb2a7483cf82d8a7;hb=c76348fc03f302ffd8201b912eef4724b3fa60a4;hp=148e3dabfec734ae74836514c15b78d1c980df77;hpb=e6243a818496aad82b6f47511d3bd9bc800f747d;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 148e3da..2dced6a 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -116,27 +116,18 @@ cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts
 cmmMiniInlineStmts uses (stmt:stmts)
   = stmt : cmmMiniInlineStmts uses stmts
 
+lookForInline u expr (stmt : rest)
+  | Just 1 <- lookupUFM (countUses stmt) u, ok_to_inline
+  = Just (inlineStmt u expr stmt : rest)
+
+  | ok_to_skip
+  = case lookForInline u expr rest of
+           Nothing    -> Nothing
+           Just stmts -> Just (stmt:stmts)
+
+  | otherwise 
+  = Nothing
 
--- Try to inline a temporary assignment.  We can skip over assignments to
--- other tempoararies, because we know that expressions aren't side-effecting
--- and temporaries are single-assignment.
-lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest)
-  | u /= u' 
-  = case lookupUFM (countUses rhs) u of
-	Just 1 -> Just (inlineStmt u expr stmt : rest)
-	_other -> case lookForInline u expr rest of
-		     Nothing    -> Nothing
-		     Just stmts -> Just (stmt:stmts)
-
-lookForInline u expr (CmmNop : rest)
-  = lookForInline u expr rest
-
-lookForInline _ _ [] = Nothing
-
-lookForInline u expr (stmt:stmts)
-  = case lookupUFM (countUses stmt) u of
-	Just 1 | ok_to_inline -> Just (inlineStmt u expr stmt : stmts)
-	_other -> Nothing
   where
 	-- we don't inline into CmmCall if the expression refers to global
 	-- registers.  This is a HACK to avoid global registers clashing with
@@ -147,6 +138,16 @@ lookForInline u expr (stmt:stmts)
 		     CmmCall{} -> hasNoGlobalRegs expr
 		     _ -> True
 
+   -- We can skip over assignments to other tempoararies, because we
+   -- know that expressions aren't side-effecting and temporaries are
+   -- single-assignment.
+    ok_to_skip = case stmt of
+                 CmmNop -> True
+                 CmmAssign (CmmLocal (LocalReg u' _)) rhs | u' /= u -> True
+                 CmmAssign g@(CmmGlobal _) rhs -> not (g `regUsedIn` expr)
+                 _other -> False
+
+
 inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
 inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
@@ -258,6 +259,8 @@ cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
     	MO_Add r -> CmmLit (CmmInt (x + y) r)
     	MO_Sub r -> CmmLit (CmmInt (x - y) r)
     	MO_Mul r -> CmmLit (CmmInt (x * y) r)
+    	MO_U_Quot r | y /= 0 -> CmmLit (CmmInt (x_u `quot` y_u) r)
+    	MO_U_Rem  r | y /= 0 -> CmmLit (CmmInt (x_u `rem`  y_u) r)
     	MO_S_Quot r | y /= 0 -> CmmLit (CmmInt (x `quot` y) r)
     	MO_S_Rem  r | y /= 0 -> CmmLit (CmmInt (x `rem` y) r)
 
@@ -430,12 +433,15 @@ cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
     	MO_Mul rep
 	   | Just p <- exactLog2 n ->
                  CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
+    	MO_U_Quot rep
+	   | Just p <- exactLog2 n ->
+                 CmmMachOp (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]
     	MO_S_Quot rep
 	   | Just p <- exactLog2 n, 
 	     CmmReg _ <- x ->	-- We duplicate x below, hence require
 				-- it is a reg.  FIXME: remove this restriction.
 		-- shift right is not the same as quot, because it rounds
-		-- to minus infinity, whereasq uot rounds toward zero.
+		-- to minus infinity, whereasq quot rounds toward zero.
 		-- To fix this up, we add one less than the divisor to the
 		-- dividend if it is a negative number.
 		--
@@ -500,23 +506,6 @@ exactLog2 x_
 
 
 -- -----------------------------------------------------------------------------
--- widening / narrowing
-
-narrowU :: Width -> Integer -> Integer
-narrowU W8  x = fromIntegral (fromIntegral x :: Word8)
-narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
-narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
-narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
-narrowU _ _ = panic "narrowTo"
-
-narrowS :: Width -> Integer -> Integer
-narrowS W8  x = fromIntegral (fromIntegral x :: Int8)
-narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
-narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
-narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
-narrowS _ _ = panic "narrowTo"
-
--- -----------------------------------------------------------------------------
 -- Loopify for C
 
 {-