diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Cmm/Lint.hs | 17 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/MachOp.hs | 2 |
2 files changed, 19 insertions, 0 deletions
diff --git a/compiler/GHC/Cmm/Lint.hs b/compiler/GHC/Cmm/Lint.hs index 7225a64141..82d7b56d14 100644 --- a/compiler/GHC/Cmm/Lint.hs +++ b/compiler/GHC/Cmm/Lint.hs @@ -98,6 +98,7 @@ lintCmmExpr (CmmLoad expr rep) = do lintCmmExpr expr@(CmmMachOp op args) = do platform <- getPlatform tys <- mapM lintCmmExpr args + lintShiftOp op (zip args tys) if map (typeWidth . cmmExprType platform) args == machOpArgReps platform op then cmmCheckMachOp op args tys else cmmLintMachOpErr expr (map (cmmExprType platform) args) (machOpArgReps platform op) @@ -110,6 +111,22 @@ lintCmmExpr expr = do platform <- getPlatform return (cmmExprType platform expr) +-- | Check for obviously out-of-bounds shift operations +lintShiftOp :: MachOp -> [(CmmExpr, CmmType)] -> CmmLint () +lintShiftOp op [(_, arg_ty), (CmmLit (CmmInt n _), _)] + | isShiftOp op + , n >= fromIntegral (widthInBits (typeWidth arg_ty)) + = cmmLintErr (text "Shift operation" <+> pprMachOp op + <+> text "has out-of-range offset" <+> ppr n + <> text ". This will result in undefined behavior") +lintShiftOp _ _ = return () + +isShiftOp :: MachOp -> Bool +isShiftOp (MO_Shl _) = True +isShiftOp (MO_U_Shr _) = True +isShiftOp (MO_S_Shr _) = True +isShiftOp _ = False + -- Check for some common byte/word mismatches (eg. Sp + 1) cmmCheckMachOp :: MachOp -> [CmmExpr] -> [CmmType] -> CmmLint CmmType cmmCheckMachOp op [lit@(CmmLit (CmmInt { })), reg@(CmmReg _)] tys diff --git a/compiler/GHC/Cmm/MachOp.hs b/compiler/GHC/Cmm/MachOp.hs index 7004fece51..cd2d331a58 100644 --- a/compiler/GHC/Cmm/MachOp.hs +++ b/compiler/GHC/Cmm/MachOp.hs @@ -102,6 +102,8 @@ data MachOp | MO_Or Width | MO_Xor Width | MO_Not Width + + -- Shifts. The shift amount must be in [0,widthInBits). | MO_Shl Width | MO_U_Shr Width -- unsigned shift right | MO_S_Shr Width -- signed shift right |