diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 2345f4f..124c2f3 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -927,6 +927,18 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct else do ByteArray.copyByteArray memory addr v 0 16 return $ Done ctx { stack = rest } + step ctx@EvalCtx{ stack = (VV128 v:rest) } (V128Store8Lane MemArg { offset } idx) = do + let i = ByteArray.indexByteArray v $ fromIntegral idx + makeStoreInstr @Word8 ctx { stack = rest } offset 1 i + step ctx@EvalCtx{ stack = (VV128 v:rest) } (V128Store16Lane MemArg { offset } idx) = do + let i = ByteArray.indexByteArray v $ fromIntegral idx + makeStoreInstr @Word16 ctx { stack = rest } offset 2 i + step ctx@EvalCtx{ stack = (VV128 v:rest) } (V128Store32Lane MemArg { offset } idx) = do + let i = ByteArray.indexByteArray v $ fromIntegral idx + makeStoreInstr @Word32 ctx { stack = rest } offset 4 i + step ctx@EvalCtx{ stack = (VV128 v:rest) } (V128Store64Lane MemArg { offset } idx) = do + let i = ByteArray.indexByteArray v $ fromIntegral idx + makeStoreInstr @Word64 ctx { stack = rest } offset 8 i step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Store8 MemArg { offset }) = makeStoreInstr @Word8 ctx { stack = rest } offset 1 $ fromIntegral v step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Store16 MemArg { offset }) = diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index f9c76e8..8b88f34 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -166,6 +166,10 @@ import Language.Wasm.Lexer ( 'f32.store' { Lexeme _ (TKeyword "f32.store") } 'f64.store' { Lexeme _ (TKeyword "f64.store") } 'v128.store' { Lexeme _ (TKeyword "v128.store") } +'v128.store8_lane' { Lexeme _ (TKeyword "v128.store8_lane") } +'v128.store16_lane' { Lexeme _ (TKeyword "v128.store16_lane") } +'v128.store32_lane' { Lexeme _ (TKeyword "v128.store32_lane") } +'v128.store64_lane' { Lexeme _ (TKeyword "v128.store64_lane") } 'i32.store8' { Lexeme _ (TKeyword "i32.store8") } 'i32.store16' { Lexeme _ (TKeyword "i32.store16") } 'i64.store8' { Lexeme _ (TKeyword "i64.store8") } @@ -574,6 +578,10 @@ plaininstr :: { PlainInstr } | 'f32.store' memarg4 { F32Store $2 } | 'f64.store' memarg8 { F64Store $2 } | 'v128.store' memarg16 { V128Store $2 } + | 'v128.store8_lane' memarg1 lane_index { V128Store8Lane $2 $3 } + | 'v128.store16_lane' memarg2 lane_index { V128Store16Lane $2 $3 } + | 'v128.store32_lane' memarg4 lane_index { V128Store32Lane $2 $3 } + | 'v128.store64_lane' memarg8 lane_index { V128Store64Lane $2 $3 } | 'i32.store8' memarg1 { I32Store8 $2 } | 'i32.store16' memarg2 { I32Store16 $2 } | 'i64.store8' memarg1 { I64Store8 $2 } @@ -1436,6 +1444,10 @@ data PlainInstr = | F32Store MemArg | F64Store MemArg | V128Store MemArg + | V128Store8Lane MemArg Natural + | V128Store16Lane MemArg Natural + | V128Store32Lane MemArg Natural + | V128Store64Lane MemArg Natural | I32Store8 MemArg | I32Store16 MemArg | I64Store8 MemArg @@ -1955,6 +1967,10 @@ desugarize fields = do synInstrToStruct _ (PlainInstr (F32Store memArg)) = return $ S.F32Store memArg synInstrToStruct _ (PlainInstr (F64Store memArg)) = return $ S.F64Store memArg synInstrToStruct _ (PlainInstr (V128Store memArg)) = return $ S.V128Store memArg + synInstrToStruct _ (PlainInstr (V128Store8Lane memArg idx)) = return $ S.V128Store8Lane memArg idx + synInstrToStruct _ (PlainInstr (V128Store16Lane memArg idx)) = return $ S.V128Store16Lane memArg idx + synInstrToStruct _ (PlainInstr (V128Store32Lane memArg idx)) = return $ S.V128Store32Lane memArg idx + synInstrToStruct _ (PlainInstr (V128Store64Lane memArg idx)) = return $ S.V128Store64Lane memArg idx synInstrToStruct _ (PlainInstr (I32Store8 memArg)) = return $ S.I32Store8 memArg synInstrToStruct _ (PlainInstr (I32Store16 memArg)) = return $ S.I32Store16 memArg synInstrToStruct _ (PlainInstr (I64Store8 memArg)) = return $ S.I64Store8 memArg diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs index 2fa576e..f9d89a5 100644 --- a/src/Language/Wasm/Structure.hs +++ b/src/Language/Wasm/Structure.hs @@ -180,6 +180,10 @@ data Instruction index = | F32Store MemArg | F64Store MemArg | V128Store MemArg + | V128Store8Lane MemArg Natural + | V128Store16Lane MemArg Natural + | V128Store32Lane MemArg Natural + | V128Store64Lane MemArg Natural | I32Store8 MemArg | I32Store16 MemArg | I64Store8 MemArg diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index 907bc07..f571c3d 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -385,6 +385,22 @@ getInstrType _ (F64Store memarg) = do getInstrType _ (V128Store memarg) = do checkMemoryInstr 16 memarg return $ [I32, V128] ==> empty +getInstrType _ (V128Store8Lane memarg idx) = do + checkMemoryInstr 1 memarg + when (idx >= 16) $ throwError LaneIndexOutOfRange + return $ [I32, V128] ==> empty +getInstrType _ (V128Store16Lane memarg idx) = do + checkMemoryInstr 2 memarg + when (idx >= 8) $ throwError LaneIndexOutOfRange + return $ [I32, V128] ==> empty +getInstrType _ (V128Store32Lane memarg idx) = do + checkMemoryInstr 4 memarg + when (idx >= 4) $ throwError LaneIndexOutOfRange + return $ [I32, V128] ==> empty +getInstrType _ (V128Store64Lane memarg idx) = do + checkMemoryInstr 8 memarg + when (idx >= 2) $ throwError LaneIndexOutOfRange + return $ [I32, V128] ==> empty getInstrType _ (I32Store8 memarg) = do checkMemoryInstr 1 memarg return $ [I32, I32] ==> empty diff --git a/tests/Test.hs b/tests/Test.hs index 16d4ed3..713f721 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -20,7 +20,7 @@ main = do filter (List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec" - -- let files = ["simd_lane.wast"] + -- let files = ["simd_store64_lane.wast"] scriptTestCases <- (`mapM` files) $ \file -> do test <- LBS.readFile ("tests/spec/" ++ file) return $ testCase file $ do