From f66bd7edd95ae1a50ebfd64496854b5a8fdf337b Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Thu, 4 Nov 2021 09:37:33 +0100 Subject: Fix Int64ToInt/Word64ToWord rules on 32-bit architectures 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) --- compiler/GHC/Core/Opt/ConstantFold.hs | 16 ++++++++-------- 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) -- cgit v1.2.1