diff options
author | Ben Gamari <ben@smart-cactus.org> | 2021-11-08 09:30:46 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2022-03-02 09:00:44 -0500 |
commit | f30469e869ca411f411d6c01f609bf9d5a3b0b8a (patch) | |
tree | 0d5216bb58200e54b03ec710281e185f2c139ede | |
parent | f91826947547ee6030e7cd4557e31d04acfa44c5 (diff) | |
download | haskell-f30469e869ca411f411d6c01f609bf9d5a3b0b8a.tar.gz |
cmm: Disallow shifts larger than shiftee
Previously primops.txt.pp stipulated that the word-size shift primops
were only defined for shift offsets in [0, word_size). However, there
was no further guidance for the definition of Cmm's sub-word size shift
MachOps.
Here we fix this by explicitly disallowing (checked in many cases by
CmmLint) shift operations where the shift offset is larger than the
shiftee. This is consistent with LLVM's shift operations, avoiding the
miscompilation noted in #20637.
(cherry picked from commit 35bbc251b5b0b1292b1335ad2aed349e8a5b79d1)
-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 03035b1198..3b7295f9f1 100644 --- a/compiler/GHC/Cmm/Lint.hs +++ b/compiler/GHC/Cmm/Lint.hs @@ -98,6 +98,7 @@ lintCmmExpr (CmmLoad expr rep _alignment) = 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 7ab59d3a1e..497bff26ad 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 |