From 4c86df25d360d4001a4a61415bbd86d4fc76d18c 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). --- 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 0d2db119a8..b9b436ffe5 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -559,10 +559,10 @@ primOpRules nm = \case -- coercions - Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] - Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] - Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] - Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] + Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] + Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] + Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] + Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ] IntToInt8Op -> mkPrimOpRule nm 1 [ liftLit narrowInt8Lit , narrowSubsumesAnd IntAndOp IntToInt8Op 8 ] IntToInt16Op -> mkPrimOpRule nm 1 [ liftLit narrowInt16Lit @@ -571,16 +571,16 @@ primOpRules nm = \case , narrowSubsumesAnd IntAndOp IntToInt32Op 32 ] IntToInt64Op -> mkPrimOpRule nm 1 [ liftLit narrowInt64Lit ] - 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 ] - Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit ] + Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit ] WordToWord8Op -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit , narrowSubsumesAnd WordAndOp WordToWord8Op 8 ] diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs index 7572b5a660..6240e3347a 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 @@ -696,13 +696,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