Allow access via manually generated SymbolPtrs. Generalize pprImportedSymbol for...

[ghc-hetmet.git] / compiler / cmm / CmmLint.hs

diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index fd4a99c..d8d6c9b 100644 (file)
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -25,10 +25,10 @@ import Control.Monad
 -- -----------------------------------------------------------------------------
 -- Exported entry points:
 
-cmmLint :: Cmm -> Maybe SDoc
+cmmLint :: GenCmm d h CmmStmt -> Maybe SDoc
 cmmLint (Cmm tops) = runCmmLint $ mapM_ lintCmmTop tops
 
-cmmLintTop :: CmmTop -> Maybe SDoc
+cmmLintTop :: GenCmmTop d h CmmStmt -> Maybe SDoc
 cmmLintTop top = runCmmLint $ lintCmmTop top
 
 runCmmLint :: CmmLint a -> Maybe SDoc
@@ -37,7 +37,7 @@ runCmmLint l =
        Left err -> Just (ptext SLIT("Cmm lint error:") $$ nest 2 err)
        Right _  -> Nothing
 
-lintCmmTop (CmmProc _info lbl _args blocks)
+lintCmmTop (CmmProc _ lbl _ blocks)
   = addLintInfo (text "in proc " <> pprCLabel lbl) $
        mapM_ lintCmmBlock blocks
 lintCmmTop _other
@@ -88,7 +88,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 +99,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