diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-11-04 09:37:33 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2022-02-17 20:46:54 -0500 |
| commit | f66bd7edd95ae1a50ebfd64496854b5a8fdf337b (patch) | |
| tree | 7fa092e8e07a2c972cdc34a4a78ed7ba7c1ec51f | |
| parent | 281f32b0bd93e9879163717626b62bcac799ceba (diff) | |
| download | haskell-wip/backports-9.2-2.tar.gz | |
Fix Int64ToInt/Word64ToWord rules on 32-bit architectureswip/backports-9.2-2
When the input literal was larger than 32-bit it would crash in a
compiler with assertion enabled because it was creating an out-of-bound
word-sized literal (32-bit).
(cherry picked from commit 4c86df25d360d4001a4a61415bbd86d4fc76d18c)
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Types/Literal.hs | 17 |
2 files changed, 17 insertions, 16 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 645329703d..f150e3320d 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -485,11 +485,11 @@ primOpRules nm = \case -- coercions - Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] - Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] - Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] + Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] + Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] + Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] #if WORD_SIZE_IN_BITS < 64 - Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] + Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] #endif IntToInt8Op -> mkPrimOpRule nm 1 [ liftLit narrowInt8Lit , semiInversePrimOp Int8ToIntOp @@ -504,17 +504,17 @@ primOpRules nm = \case IntToInt64Op -> mkPrimOpRule nm 1 [ liftLit narrowInt64Lit ] #endif - Word8ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit + Word8ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit , extendNarrowPassthrough WordToWord8Op 0xFF ] - Word16ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit + Word16ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit , extendNarrowPassthrough WordToWord16Op 0xFFFF ] - Word32ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit + Word32ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit , extendNarrowPassthrough WordToWord32Op 0xFFFFFFFF ] #if WORD_SIZE_IN_BITS < 64 - Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit ] + Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit ] #endif WordToWord8Op -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs index 74a7ee070a..f632bf6a39 100644 --- a/compiler/GHC/Types/Literal.hs +++ b/compiler/GHC/Types/Literal.hs @@ -58,7 +58,7 @@ module GHC.Types.Literal -- ** Coercions , narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit , narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit - , extendIntLit, extendWordLit + , convertToIntLit, convertToWordLit , charToIntLit, intToCharLit , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit , nullAddrLit, floatToDoubleLit, doubleToFloatLit @@ -682,13 +682,14 @@ narrowWord16Lit = narrowLit' @Word16 LitNumWord16 narrowWord32Lit = narrowLit' @Word32 LitNumWord32 narrowWord64Lit = narrowLit' @Word64 LitNumWord64 --- | Extend a fixed-width literal (e.g. 'Int16#') to a word-sized literal (e.g. --- 'Int#'). -extendWordLit, extendIntLit :: Platform -> Literal -> Literal -extendWordLit platform (LitNumber _nt i) = mkLitWord platform i -extendWordLit _platform l = pprPanic "extendWordLit" (ppr l) -extendIntLit platform (LitNumber _nt i) = mkLitInt platform i -extendIntLit _platform l = pprPanic "extendIntLit" (ppr l) +-- | Extend or narrow a fixed-width literal (e.g. 'Int16#') to a target +-- word-sized literal ('Int#' or 'Word#'). Narrowing can only happen on 32-bit +-- architectures when we convert a 64-bit literal into a 32-bit one. +convertToWordLit, convertToIntLit :: Platform -> Literal -> Literal +convertToWordLit platform (LitNumber _nt i) = mkLitWordWrap platform i +convertToWordLit _platform l = pprPanic "convertToWordLit" (ppr l) +convertToIntLit platform (LitNumber _nt i) = mkLitIntWrap platform i +convertToIntLit _platform l = pprPanic "convertToIntLit" (ppr l) charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) charToIntLit l = pprPanic "charToIntLit" (ppr l) |