) where
import BlockId
-import Cmm
+import OldCmm
import CLabel
-import Maybe
import Outputable
-import PprCmm
+import OldPprCmm()
import Constants
import FastString
-import Control.Monad
+import Data.Maybe
-- -----------------------------------------------------------------------------
-- Exported entry points:
Right _ -> Nothing
lintCmmTop :: (GenCmmTop h i (ListGraph CmmStmt)) -> CmmLint ()
-lintCmmTop (CmmProc _ lbl _ (ListGraph blocks))
+lintCmmTop (CmmProc _ lbl (ListGraph blocks))
= addLintInfo (text "in proc " <> pprCLabel lbl) $
- let labels = foldl (\s b -> extendBlockSet s (blockId b)) emptyBlockSet blocks
+ let labels = foldl (\s b -> setInsert (blockId b) s) setEmpty blocks
in mapM_ (lintCmmBlock labels) blocks
lintCmmTop (CmmData {})
lintCmmExpr :: CmmExpr -> CmmLint CmmType
lintCmmExpr (CmmLoad expr rep) = do
- lintCmmExpr expr
- when (widthInBytes (typeWidth rep) >= wORD_SIZE) $
- cmmCheckWordAddress expr
+ _ <- lintCmmExpr expr
+ -- Disabled, if we have the inlining phase before the lint phase,
+ -- we can have funny offsets due to pointer tagging. -- EZY
+ -- when (widthInBytes (typeWidth rep) >= wORD_SIZE) $
+ -- cmmCheckWordAddress expr
return rep
lintCmmExpr expr@(CmmMachOp op args) = do
tys <- mapM lintCmmExpr args
-- This expression should be an address from which a word can be loaded:
-- check for funny-looking sub-word offsets.
-cmmCheckWordAddress :: CmmExpr -> CmmLint ()
-cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
+_cmmCheckWordAddress :: CmmExpr -> CmmLint ()
+_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
= cmmLintDubiousWordOffset e
-cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
+_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
= cmmLintDubiousWordOffset e
-cmmCheckWordAddress _
+_cmmCheckWordAddress _
= return ()
-- No warnings for unaligned arithmetic with the node register,
then return ()
else cmmLintAssignErr stmt erep reg_ty
lint (CmmStore l r) = do
- lintCmmExpr l
- lintCmmExpr r
+ _ <- lintCmmExpr l
+ _ <- lintCmmExpr r
return ()
lint (CmmCall target _res args _ _) =
lintTarget target >> mapM_ (lintCmmExpr . hintlessCmm) args
lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . hintlessCmm) args
lint (CmmReturn ress) = mapM_ (lintCmmExpr . hintlessCmm) ress
lint (CmmBranch id) = checkTarget id
- checkTarget id = if elemBlockSet id labels then return ()
+ checkTarget id = if setMember id labels then return ()
else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)
lintTarget :: CmmCallTarget -> CmmLint ()
checkCond :: CmmExpr -> CmmLint ()
checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
+checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
checkCond expr = cmmLintErr (hang (text "expression is not a conditional:") 2
(ppr expr))
cmmLintMachOpErr :: CmmExpr -> [CmmType] -> [Width] -> CmmLint a
cmmLintMachOpErr expr argsRep opExpectsRep
= cmmLintErr (text "in MachOp application: " $$
- nest 2 (pprExpr expr) $$
+ nest 2 (ppr expr) $$
(text "op is expecting: " <+> ppr opExpectsRep) $$
(text "arguments provide: " <+> ppr argsRep))
cmmLintAssignErr :: CmmStmt -> CmmType -> CmmType -> CmmLint a
cmmLintAssignErr stmt e_ty r_ty
= cmmLintErr (text "in assignment: " $$
- nest 2 (vcat [pprStmt stmt,
+ nest 2 (vcat [ppr stmt,
text "Reg ty:" <+> ppr r_ty,
text "Rhs ty:" <+> ppr e_ty]))
cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
cmmLintDubiousWordOffset expr
= cmmLintErr (text "offset is not a multiple of words: " $$
- nest 2 (pprExpr expr))
+ nest 2 (ppr expr))