diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2021-11-22 21:18:20 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2022-03-02 22:49:17 -0500 |
| commit | 299bddfc6198c6f65a20d1a79074d828e9ca4649 (patch) | |
| tree | 4f8862b3056aa2b83e9eb5ccb548ed2c2da9d123 | |
| parent | 934fce23db27cbe767c1758b7fff177c05d8ed43 (diff) | |
| download | haskell-299bddfc6198c6f65a20d1a79074d828e9ca4649.tar.gz | |
CmmToC: Fix width of shift operations
Under C's implicit widening rules, the result of an operation like (a >>
b) where a::Word8 and b::Word will have type Word, yet we want Word.
(cherry picked from commit e19e9e71739ffd01d6557256b59b3bd26651a4ad)
| -rw-r--r-- | compiler/GHC/CmmToC.hs | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs index 3c604f0f96..f4ff57cdfc 100644 --- a/compiler/GHC/CmmToC.hs +++ b/compiler/GHC/CmmToC.hs @@ -436,12 +436,18 @@ pprMachOpApp platform mop args | otherwise = pprMachOpApp' platform mop args --- Comparisons in C have type 'int', but we want type W_ (this is what --- resultRepOfMachOp says). The other C operations inherit their type --- from their operands, so no casting is required. +-- | The type of most operations is determined by the operands. However, there are a few exceptions. For these we explicitly cast the result. machOpNeedsCast :: MachOp -> Maybe SDoc machOpNeedsCast mop + -- Comparisons in C have type 'int', but we want type W_ (this is what + -- resultRepOfMachOp says). | isComparisonMachOp mop = Just mkW_ + -- A shift operation like (a >> b) where a::Word8 and b::Word has type Word + -- in C yet we want a Word8 + | w <- shiftMachOp mop = let ty + | signedOp mop = machRep_S_CType platform w + | otherwise = machRep_U_CType platform w + in Just $ parens ty | otherwise = Nothing pprMachOpApp' :: Platform -> MachOp -> [CmmExpr] -> SDoc @@ -769,6 +775,12 @@ signedOp (MO_SS_Conv _ _) = True signedOp (MO_SF_Conv _ _) = True signedOp _ = False +shiftOp :: MachOp -> Maybe Width +shiftOp (MO_Shl w) = Just w +shiftOp (MO_U_Shr w) = Just w +shiftOp (MO_S_Shr w) = Just w +shiftOp _ = Nothing + floatComparison :: MachOp -> Bool -- comparison between float args floatComparison (MO_F_Eq _) = True floatComparison (MO_F_Ne _) = True |