[Git][ghc/ghc][master] compiler: fix subword literal narrowing logic in the wasm NCG

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00
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.

- - - - -


4 changed files:

- compiler/GHC/CmmToAsm/Wasm/Asm.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/Wasm/Types.hs
- compiler/GHC/CmmToAsm/Wasm/Utils.hs


Changes:

=====================================
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 ->


=====================================
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 $


=====================================
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


=====================================
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
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e11c6dc25cb9dd14ae33ee9715ddbc8ebf9836e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e11c6dc25cb9dd14ae33ee9715ddbc8ebf9836e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230128/2b92b9ec/attachment-0001.html>