GitHub/haskell-wasm
1
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

implement v128.store[8|16|32|64]_lane

Browse Source
This commit is contained in:
Ilya Rezvov
2023-09-06 21:35:16 -06:00
parent 5c6e9b59bc
commit d9803479a0
5 changed files with 49 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+12
View File
@@ -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 }) =
src/Language/Wasm/Parser.y
+16
View File
@@ -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
src/Language/Wasm/Structure.hs
+4
View File
@@ -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
src/Language/Wasm/Validate.hs
+16
View File
@@ -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
tests/Test.hs
+1 -1
View File
@@ -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