summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorCheng Shao <terrorjack@type.dance>2023-01-27 12:47:40 +0000
committerMatthew Pickering <matthewtpickering@gmail.com>2023-02-01 13:18:47 +0000
commitfdfd89117b20f064f38cb61a35cb234b22ec0a0e (patch)
tree4950c956122ddd1a38db6fe58d0459aa4aa7bdc2 /compiler
parentfb1863999cf44625370d927a9a821c169d6f484a (diff)
downloadhaskell-fdfd89117b20f064f38cb61a35cb234b22ec0a0e.tar.gz
compiler: fix subword literal narrowing logic in the wasm NCG
This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. (cherry picked from commit 7e11c6dc25cb9dd14ae33ee9715ddbc8ebf9836e)
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/CmmToAsm/Wasm/Asm.hs8
-rw-r--r--compiler/GHC/CmmToAsm/Wasm/FromCmm.hs10
-rw-r--r--compiler/GHC/CmmToAsm/Wasm/Types.hs9
-rw-r--r--compiler/GHC/CmmToAsm/Wasm/Utils.hs8
4 files changed, 15 insertions, 20 deletions
diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
index 6f342818a4..d7acc0e459 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Asm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
@@ -118,10 +118,10 @@ asmTellDefSym sym = do
asmTellDataSectionContent :: WasmTypeTag w -> DataSectionContent -> WasmAsmM ()
asmTellDataSectionContent ty_word c = asmTellTabLine $ case c of
- DataI8 i -> ".int8 " <> integerDec i
- DataI16 i -> ".int16 " <> integerDec i
- DataI32 i -> ".int32 " <> integerDec i
- DataI64 i -> ".int64 " <> integerDec i
+ DataI8 i -> ".int8 0x" <> word8Hex i
+ DataI16 i -> ".int16 0x" <> word16Hex i
+ DataI32 i -> ".int32 0x" <> word32Hex i
+ DataI64 i -> ".int64 0x" <> word64Hex i
DataF32 f -> ".int32 0x" <> word32Hex (castFloatToWord32 f)
DataF64 d -> ".int64 0x" <> word64Hex (castDoubleToWord64 d)
DataSym sym o ->
diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
index e1ca600cba..2a2fafda4a 100644
--- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
@@ -134,10 +134,10 @@ alignmentFromCmmSection t lbl
-- | Lower a 'CmmStatic'.
lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic s = case s of
- CmmStaticLit (CmmInt i W8) -> pure $ DataI8 $ naturalNarrowing W8 i
- CmmStaticLit (CmmInt i W16) -> pure $ DataI16 $ naturalNarrowing W16 i
- CmmStaticLit (CmmInt i W32) -> pure $ DataI32 $ naturalNarrowing W32 i
- CmmStaticLit (CmmInt i W64) -> pure $ DataI64 $ naturalNarrowing W64 i
+ CmmStaticLit (CmmInt i W8) -> pure $ DataI8 $ fromInteger $ narrowU W8 i
+ CmmStaticLit (CmmInt i W16) -> pure $ DataI16 $ fromInteger $ narrowU W16 i
+ CmmStaticLit (CmmInt i W32) -> pure $ DataI32 $ fromInteger $ narrowU W32 i
+ CmmStaticLit (CmmInt i W64) -> pure $ DataI64 $ fromInteger $ narrowU W64 i
CmmStaticLit (CmmFloat f W32) -> pure $ DataF32 $ fromRational f
CmmStaticLit (CmmFloat d W64) -> pure $ DataF64 $ fromRational d
CmmStaticLit (CmmLabel lbl) ->
@@ -831,7 +831,7 @@ lower_CmmLit lit = do
SomeWasmExpr ty $
WasmExpr $
WasmConst ty $
- naturalNarrowing w i
+ narrowU w i
CmmFloat f W32 ->
pure $
SomeWasmExpr TagF32 $
diff --git a/compiler/GHC/CmmToAsm/Wasm/Types.hs b/compiler/GHC/CmmToAsm/Wasm/Types.hs
index 284d62b173..50b1234f30 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Types.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Types.hs
@@ -57,6 +57,7 @@ import qualified Data.IntSet as IS
import Data.Kind
import Data.String
import Data.Type.Equality
+import Data.Word
import GHC.Cmm
import GHC.Data.FastString
import GHC.Float
@@ -174,10 +175,10 @@ data DataSectionKind = SectionData | SectionROData
-- account, therefore we always round up a 'CmmLit' to the right width
-- and handle it as an untyped integer.
data DataSectionContent
- = DataI8 Integer
- | DataI16 Integer
- | DataI32 Integer
- | DataI64 Integer
+ = DataI8 Word8
+ | DataI16 Word16
+ | DataI32 Word32
+ | DataI64 Word64
| DataF32 Float
| DataF64 Double
| DataSym SymName Int
diff --git a/compiler/GHC/CmmToAsm/Wasm/Utils.hs b/compiler/GHC/CmmToAsm/Wasm/Utils.hs
index b794c7f5b7..61dfc9bfb2 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Utils.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Utils.hs
@@ -2,8 +2,7 @@
{-# LANGUAGE Strict #-}
module GHC.CmmToAsm.Wasm.Utils
- ( naturalNarrowing,
- widthMax,
+ ( widthMax,
detEltsUFM,
detEltsUniqMap,
builderCommas,
@@ -17,11 +16,6 @@ import GHC.Prelude
import GHC.Types.Unique.FM
import GHC.Types.Unique.Map
-naturalNarrowing :: Width -> Integer -> Integer
-naturalNarrowing w i
- | i < 0 = narrowS w i
- | otherwise = narrowU w i
-
widthMax :: Width -> Integer
widthMax w = (1 `shiftL` widthInBits w) - 1