X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLint.hs;h=c2ef7e76c84d44f1e1729b31fdeb51cebf960361;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hp=130dba05f9cec5299afab5eb3326fb43c13cf617;hpb=f96e9aa0444de0e673b3c4055c6e43299639bc5b;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 130dba0..c2ef7e7 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -1,3 +1,10 @@
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2004-2006
@@ -88,7 +95,8 @@ cmmCheckMachOp op args
   = return (resultRepOfMachOp op)
 
 isWordOffsetReg (CmmGlobal Sp) = True
-isWordOffsetReg (CmmGlobal Hp) = True
+-- No warnings for unaligned arithmetic, which is used to tag dynamic constructor closures.
+--isWordOffsetReg (CmmGlobal Hp) = True
 isWordOffsetReg _ = False
 
 isOffsetOp (MO_Add _) = True
@@ -98,14 +106,18 @@ isOffsetOp _ = False
 -- This expression should be an address from which a word can be loaded:
 -- check for funny-looking sub-word offsets.
 cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
-  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
+  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
   = cmmLintDubiousWordOffset e
 cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
-  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
+  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
   = cmmLintDubiousWordOffset e
 cmmCheckWordAddress _
   = return ()
 
+-- No warnings for unaligned arithmetic with the node register,
+-- which is used to extract fields from tagged constructor closures.
+notNodeReg (CmmReg reg) | reg == nodeReg = False
+notNodeReg _                             = True
 
 lintCmmStmt :: CmmStmt -> CmmLint ()
 lintCmmStmt stmt@(CmmAssign reg expr) = do
@@ -117,7 +129,7 @@ lintCmmStmt (CmmStore l r) = do
   lintCmmExpr l
   lintCmmExpr r
   return ()
-lintCmmStmt (CmmCall _target _res args _) = mapM_ (lintCmmExpr.fst) args
+lintCmmStmt (CmmCall _target _res args _ _) = mapM_ (lintCmmExpr.fst) args
 lintCmmStmt (CmmCondBranch e _id)   = lintCmmExpr e >> checkCond e >> return ()
 lintCmmStmt (CmmSwitch e _branches) = do
   erep <- lintCmmExpr e