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

implement basic load/store for v128

Browse Source
This commit is contained in:
Ilya Rezvov
2023-09-04 18:35:59 -06:00
parent d81143e5f8
commit c6e0bfea89
5 changed files with 40 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+20
View File
@@ -868,6 +868,16 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
makeLoadInstr ctx offset 4 $ (\rest val -> Done ctx { stack = VF32 (wordToFloat val) : rest })
step ctx (F64Load MemArg { offset }) =
makeLoadInstr ctx offset 8 $ (\rest val -> Done ctx { stack = VF64 (wordToDouble val) : rest })
step ctx@EvalCtx{ stack = (VI32 v:rest) } (V128Load MemArg { offset }) = do
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral v + fromIntegral offset
len <- ByteArray.getSizeofMutableByteArray memory
if addr + 16 > len
then return Trap
else do
val <- ByteArray.freezeByteArray memory addr 16
return $ Done ctx { stack = VV128 val : rest }
step ctx (I32Load8U MemArg { offset }) =
makeLoadInstr @Word8 ctx offset 1 $ (\rest val -> Done ctx { stack = VI32 (fromIntegral val) : rest })
step ctx (I32Load8S MemArg { offset }) =
@@ -906,6 +916,16 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
makeStoreInstr ctx { stack = rest } offset 4 $ floatToWord f
step ctx@EvalCtx{ stack = (VF64 f:rest) } (F64Store MemArg { offset }) =
makeStoreInstr ctx { stack = rest } offset 8 $ doubleToWord f
step ctx@EvalCtx{ stack = (VV128 v:VI32 va:rest) } (V128Store MemArg { offset }) = do
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset
len <- ByteArray.getSizeofMutableByteArray memory
if addr + 16 > len
then return Trap
else do
ByteArray.copyByteArray memory addr v 0 16
return $ Done ctx { stack = rest }
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
+11
View File
@@ -150,6 +150,7 @@ import Language.Wasm.Lexer (
'i64.load' { Lexeme _ (TKeyword "i64.load") }
'f32.load' { Lexeme _ (TKeyword "f32.load") }
'f64.load' { Lexeme _ (TKeyword "f64.load") }
'v128.load' { Lexeme _ (TKeyword "v128.load") }
'i32.load8_s' { Lexeme _ (TKeyword "i32.load8_s") }
'i32.load8_u' { Lexeme _ (TKeyword "i32.load8_u") }
'i32.load16_s' { Lexeme _ (TKeyword "i32.load16_s") }
@@ -164,6 +165,7 @@ import Language.Wasm.Lexer (
'i64.store' { Lexeme _ (TKeyword "i64.store") }
'f32.store' { Lexeme _ (TKeyword "f32.store") }
'f64.store' { Lexeme _ (TKeyword "f64.store") }
'v128.store' { Lexeme _ (TKeyword "v128.store") }
'i32.store8' { Lexeme _ (TKeyword "i32.store8") }
'i32.store16' { Lexeme _ (TKeyword "i32.store16") }
'i64.store8' { Lexeme _ (TKeyword "i64.store8") }
@@ -513,6 +515,7 @@ plaininstr :: { PlainInstr }
| 'i64.load' memarg8 { I64Load $2 }
| 'f32.load' memarg4 { F32Load $2 }
| 'f64.load' memarg8 { F64Load $2 }
| 'v128.load' memarg16 { V128Load $2 }
| 'i32.load8_s' memarg1 { I32Load8S $2 }
| 'i32.load8_u' memarg1 { I32Load8U $2 }
| 'i32.load16_s' memarg2 { I32Load16S $2 }
@@ -527,6 +530,7 @@ plaininstr :: { PlainInstr }
| 'i64.store' memarg8 { I64Store $2 }
| 'f32.store' memarg4 { F32Store $2 }
| 'f64.store' memarg8 { F64Store $2 }
| 'v128.store' memarg16 { V128Store $2 }
| 'i32.store8' memarg1 { I32Store8 $2 }
| 'i32.store16' memarg2 { I32Store16 $2 }
| 'i64.store8' memarg1 { I64Store8 $2 }
@@ -762,6 +766,9 @@ memarg4 :: { MemArg }
memarg8 :: { MemArg }
: opt(offset) opt(align) {% parseMemArg 8 $1 $2 }
memarg16 :: { MemArg }
: opt(offset) opt(align) {% parseMemArg 16 $1 $2 }
select_type_or_instructions(terminator)
: '(' select_type_or_instructions1(terminator) { $2 }
| instruction_list(terminator) {
@@ -1330,6 +1337,7 @@ data PlainInstr =
| I64Load MemArg
| F32Load MemArg
| F64Load MemArg
| V128Load MemArg
| I32Load8S MemArg
| I32Load8U MemArg
| I32Load16S MemArg
@@ -1344,6 +1352,7 @@ data PlainInstr =
| I64Store MemArg
| F32Store MemArg
| F64Store MemArg
| V128Store MemArg
| I32Store8 MemArg
| I32Store16 MemArg
| I64Store8 MemArg
@@ -1839,6 +1848,7 @@ desugarize fields = do
synInstrToStruct _ (PlainInstr (I64Load memArg)) = return $ S.I64Load memArg
synInstrToStruct _ (PlainInstr (F32Load memArg)) = return $ S.F32Load memArg
synInstrToStruct _ (PlainInstr (F64Load memArg)) = return $ S.F64Load memArg
synInstrToStruct _ (PlainInstr (V128Load memArg)) = return $ S.V128Load memArg
synInstrToStruct _ (PlainInstr (I32Load8S memArg)) = return $ S.I32Load8S memArg
synInstrToStruct _ (PlainInstr (I32Load8U memArg)) = return $ S.I32Load8U memArg
synInstrToStruct _ (PlainInstr (I32Load16S memArg)) = return $ S.I32Load16S memArg
@@ -1853,6 +1863,7 @@ desugarize fields = do
synInstrToStruct _ (PlainInstr (I64Store memArg)) = return $ S.I64Store memArg
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 (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
+2
View File
@@ -164,6 +164,7 @@ data Instruction index =
| I64Load MemArg
| F32Load MemArg
| F64Load MemArg
| V128Load MemArg
| I32Load8S MemArg
| I32Load8U MemArg
| I32Load16S MemArg
@@ -178,6 +179,7 @@ data Instruction index =
| I64Store MemArg
| F32Store MemArg
| F64Store MemArg
| V128Store MemArg
| I32Store8 MemArg
| I32Store16 MemArg
| I64Store8 MemArg
src/Language/Wasm/Validate.hs
+6
View File
@@ -336,6 +336,9 @@ getInstrType _ (F32Load memarg) = do
getInstrType _ (F64Load memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> F64
getInstrType _ (V128Load memarg) = do
checkMemoryInstr 16 memarg
return $ I32 ==> V128
getInstrType _ (I32Load8S memarg) = do
checkMemoryInstr 1 memarg
return $ I32 ==> I32
@@ -378,6 +381,9 @@ getInstrType _ (F32Store memarg) = do
getInstrType _ (F64Store memarg) = do
checkMemoryInstr 8 memarg
return $ [I32, F64] ==> empty
getInstrType _ (V128Store memarg) = do
checkMemoryInstr 16 memarg
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_const.wast"]
let files = ["simd_store.wast"]
scriptTestCases <- (`mapM` files) $ \file -> do
test <- LBS.readFile ("tests/spec/" ++ file)
return $ testCase file $ do