From 02e2c4a7055a80890ffcb96480999f9b57138f98 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <ilya.rezvov@revjet.com>
Date: Mon, 8 Mar 2021 21:58:21 -0800
Subject: [PATCH] fix align bug for I64Load32U and start mutable globals
 export/import proposal

---
 src/Language/Wasm/Binary.hs   | 12 ++++++++++++
 src/Language/Wasm/Script.hs   |  2 --
 src/Language/Wasm/Validate.hs | 17 +++--------------
 tests/Test.hs                 |  2 +-
 4 files changed, 16 insertions(+), 17 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index 2ef6ae6..d8d30c9 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -492,6 +492,13 @@ instance Serialize (Instruction Natural) where
     put (FReinterpretI BS32) = putWord8 0xBE
     put (FReinterpretI BS64) = putWord8 0xBF
 
+    put (IUnOp BS32 IExtend8S) = putWord8 0xC0
+    put (IUnOp BS32 IExtend16S) = putWord8 0xC1
+    put (IUnOp BS32 IExtend32S) = error "Opcode for i32.extend32_s doesn't exist"
+    put (IUnOp BS64 IExtend8S) = putWord8 0xC2
+    put (IUnOp BS64 IExtend16S) = putWord8 0xC3
+    put (IUnOp BS64 IExtend32S) = putWord8 0xC4
+
     get = do
         op <- getWord8
         case op of
@@ -676,6 +683,11 @@ instance Serialize (Instruction Natural) where
             0xBD -> return $ IReinterpretF BS64
             0xBE -> return $ FReinterpretI BS32
             0xBF -> return $ FReinterpretI BS64
+            0xC0 -> return $ IUnOp BS32 IExtend8S
+            0xC1 -> return $ IUnOp BS32 IExtend16S
+            0xC2 -> return $ IUnOp BS64 IExtend8S
+            0xC3 -> return $ IUnOp BS64 IExtend16S
+            0xC4 -> return $ IUnOp BS64 IExtend32S
             _ -> fail "Unknown byte value in place of instruction opcode"
 
 putExpression :: Expression -> Put
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index 02d6813..603ba08 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -175,8 +175,6 @@ runScript onAssertFail script = do
         getFailureString Validate.InvalidConstantExpr = ["constant expression required"]
         getFailureString Validate.InvalidResultArity = ["invalid result arity"]
         getFailureString Validate.GlobalIsImmutable = ["global is immutable"]
-        getFailureString Validate.ImportedGlobalIsNotConst = ["mutable globals cannot be imported"]
-        getFailureString Validate.ExportedGlobalIsNotConst = ["mutable globals cannot be exported"]
         getFailureString Validate.InvalidStartFunctionType = ["start function"]
         getFailureString r = [TL.concat ["not implemented ", (TL.pack $ show r)]]
 
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index b773e0b..55bd7c1 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -45,8 +45,6 @@ data ValidationError =
     | InvalidResultArity
     | InvalidConstantExpr
     | InvalidStartFunctionType
-    | ImportedGlobalIsNotConst
-    | ExportedGlobalIsNotConst
     | GlobalIsImmutable
     deriving (Show, Eq)
 
@@ -299,7 +297,7 @@ getInstrType (I64Load32S memarg) = do
     checkMemoryInstr 4 memarg
     return $ I32 ==> I64
 getInstrType (I64Load32U memarg) = do
-    checkMemoryInstr 8 memarg
+    checkMemoryInstr 4 memarg
     return $ I32 ==> I64
 getInstrType (I32Store memarg) = do
     checkMemoryInstr 4 memarg
@@ -592,15 +590,7 @@ exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals
             if fromIntegral memIdx < length memImports + length mems then return () else Left (MemoryIndexOutOfRange memIdx)
         isExportValid (Export _ (ExportGlobal globalIdx)) =
             if fromIntegral globalIdx < length globalImports + length globals
-            then (
-                if fromIntegral globalIdx >= length globalImports
-                then (
-                    case globals !! (fromIntegral globalIdx - length globalImports) of
-                        (Global (Mut _) _) -> Left ExportedGlobalIsNotConst
-                        _ -> return ()
-                )
-                else return ()
-            )
+            then return ()
             else Left (GlobalIndexOutOfRange globalIdx)
 
         areExportNamesUnique :: ValidationResult
@@ -626,8 +616,7 @@ importsShouldBeValid Module { imports, types } =
             else Left TypeIndexOutOfRange
         isImportValid (Import _ _ (ImportTable _)) = return () -- checked in tables section
         isImportValid (Import _ _ (ImportMemory _)) = return () -- checked in mems section
-        isImportValid (Import _ _ (ImportGlobal (Const _))) = return ()
-        isImportValid (Import _ _ (ImportGlobal (Mut _))) = Left ImportedGlobalIsNotConst
+        isImportValid (Import _ _ (ImportGlobal _)) = return ()
 
 typesShouldBeValid :: Validator
 typesShouldBeValid Module { types } = foldMap isTypeValid types
diff --git a/tests/Test.hs b/tests/Test.hs
index 4c22eb1..f66b65f 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -17,7 +17,7 @@ import qualified Data.List as List
 main :: IO ()
 main = do
   files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-  -- let files = ["call.wast"]
+  -- let files = ["linking.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do