msyds/haskell-wasm
1
0
Fork 0
forked from GitHub/haskell-wasm
Code Pull Requests Activity

implement v128.load with signed and unsigined extend

Browse Source
This commit is contained in:
Ilya Rezvov
2023-09-08 11:32:13 -06:00
parent dad521025e
commit f16ccb85a9
5 changed files with 104 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+55 -10
View File
@@ -717,6 +717,19 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
)
makeLoadInstr _ _ _ _ = error "Incorrect value on top of stack for memory instruction"
loadByteArray :: EvalCtx -> Natural -> Int -> ([Value] -> ByteArray.ByteArray -> EvalResult) -> IO EvalResult
loadByteArray ctx@EvalCtx{ stack = (VI32 v:rest) } offset byteWidth cont = 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 + byteWidth > len
then return Trap
else do
val <- ByteArray.freezeByteArray memory addr byteWidth
return $ cont rest val
loadByteArray _ _ _ _ = error "Incorrect value on top of stack for memory instruction"
makeStoreInstr :: (Primitive.Prim i, Bits i, Integral i) => EvalCtx -> Natural -> Int -> i -> IO EvalResult
makeStoreInstr ctx@EvalCtx{ stack = (VI32 va:rest) } offset byteWidth v = do
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
@@ -869,16 +882,9 @@ 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 (V128Load MemArg { offset }) =
loadByteArray ctx offset 16 $ \rest arr ->
Done ctx { stack = VV128 arr : rest }
step ctx (V128Load8Splat MemArg { offset }) =
makeLoadInstr @Word8 ctx offset 1 $ \rest val ->
let v = ByteArray.byteArrayFromListN 16 $ replicate 16 val in
@@ -903,6 +909,45 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
makeLoadInstr @Word64 ctx offset 8 $ \rest val ->
let v = ByteArray.byteArrayFromListN 2 [val, 0] in
Done ctx { stack = VV128 v : rest }
step ctx (V128Load8x8S MemArg { offset }) =
loadByteArray ctx offset 8 $ \rest arr ->
let ext b = if b >= 0x80 then 0xFF00 + fromIntegral b else fromIntegral b in
let v = ByteArray.byteArrayFromListN @Word16 8
$ ByteArray.foldrByteArray @Word8 (\b -> (ext b:)) [] arr
in
Done ctx { stack = VV128 v : rest }
step ctx (V128Load8x8U MemArg { offset }) =
loadByteArray ctx offset 8 $ \rest arr ->
let v = ByteArray.byteArrayFromListN @Word16 8
$ ByteArray.foldrByteArray @Word8 (\b -> (fromIntegral b:)) [] arr
in
Done ctx { stack = VV128 v : rest }
step ctx (V128Load16x4S MemArg { offset }) =
loadByteArray ctx offset 8 $ \rest arr ->
let ext b = if b >= 0x8000 then 0xFFFF0000 + fromIntegral b else fromIntegral b in
let v = ByteArray.byteArrayFromListN @Word32 4
$ ByteArray.foldrByteArray @Word16 (\b -> (ext b:)) [] arr
in
Done ctx { stack = VV128 v : rest }
step ctx (V128Load16x4U MemArg { offset }) =
loadByteArray ctx offset 8 $ \rest arr ->
let v = ByteArray.byteArrayFromListN @Word32 4
$ ByteArray.foldrByteArray @Word16 (\b -> (fromIntegral b:)) [] arr
in
Done ctx { stack = VV128 v : rest }
step ctx (V128Load32x2S MemArg { offset }) =
loadByteArray ctx offset 8 $ \rest arr ->
let ext b = if b >= 0x80000000 then 0xFFFFFFFF00000000 + fromIntegral b else fromIntegral b in
let v = ByteArray.byteArrayFromListN @Word64 2
$ ByteArray.foldrByteArray @Word32 (\b -> (ext b:)) [] arr
in
Done ctx { stack = VV128 v : rest }
step ctx (V128Load32x2U MemArg { offset }) =
loadByteArray ctx offset 8 $ \rest arr ->
let v = ByteArray.byteArrayFromListN @Word64 2
$ ByteArray.foldrByteArray @Word32 (\b -> (fromIntegral b:)) [] arr
in
Done ctx { stack = VV128 v : 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 }) =
src/Language/Wasm/Parser.y
+24
View File
@@ -157,6 +157,12 @@ import Language.Wasm.Lexer (
'v128.load64_splat' { Lexeme _ (TKeyword "v128.load64_splat") }
'v128.load32_zero' { Lexeme _ (TKeyword "v128.load32_zero") }
'v128.load64_zero' { Lexeme _ (TKeyword "v128.load64_zero") }
'v128.load8x8_s' { Lexeme _ (TKeyword "v128.load8x8_s") }
'v128.load8x8_u' { Lexeme _ (TKeyword "v128.load8x8_u") }
'v128.load16x4_s' { Lexeme _ (TKeyword "v128.load16x4_s") }
'v128.load16x4_u' { Lexeme _ (TKeyword "v128.load16x4_u") }
'v128.load32x2_s' { Lexeme _ (TKeyword "v128.load32x2_s") }
'v128.load32x2_u' { Lexeme _ (TKeyword "v128.load32x2_u") }
'i32.load8_s' { Lexeme _ (TKeyword "i32.load8_s") }
'i32.load8_u' { Lexeme _ (TKeyword "i32.load8_u") }
'i32.load16_s' { Lexeme _ (TKeyword "i32.load16_s") }
@@ -575,6 +581,12 @@ plaininstr :: { PlainInstr }
| 'v128.load64_splat' memarg8 { V128Load64Splat $2 }
| 'v128.load32_zero' memarg4 { V128Load32Zero $2 }
| 'v128.load64_zero' memarg8 { V128Load64Zero $2 }
| 'v128.load8x8_s' memarg8 { V128Load8x8S $2 }
| 'v128.load8x8_u' memarg8 { V128Load8x8U $2 }
| 'v128.load16x4_s' memarg8 { V128Load16x4S $2 }
| 'v128.load16x4_u' memarg8 { V128Load16x4U $2 }
| 'v128.load32x2_s' memarg8 { V128Load32x2S $2 }
| 'v128.load32x2_u' memarg8 { V128Load32x2U $2 }
| 'i32.load8_s' memarg1 { I32Load8S $2 }
| 'i32.load8_u' memarg1 { I32Load8U $2 }
| 'i32.load16_s' memarg2 { I32Load16S $2 }
@@ -1447,6 +1459,12 @@ data PlainInstr =
| V128Load64Splat MemArg
| V128Load32Zero MemArg
| V128Load64Zero MemArg
| V128Load8x8S MemArg
| V128Load8x8U MemArg
| V128Load16x4S MemArg
| V128Load16x4U MemArg
| V128Load32x2S MemArg
| V128Load32x2U MemArg
| I32Load8S MemArg
| I32Load8U MemArg
| I32Load16S MemArg
@@ -1976,6 +1994,12 @@ desugarize fields = do
synInstrToStruct _ (PlainInstr (V128Load64Splat memArg)) = return $ S.V128Load64Splat memArg
synInstrToStruct _ (PlainInstr (V128Load32Zero memArg)) = return $ S.V128Load32Zero memArg
synInstrToStruct _ (PlainInstr (V128Load64Zero memArg)) = return $ S.V128Load64Zero memArg
synInstrToStruct _ (PlainInstr (V128Load8x8S memArg)) = return $ S.V128Load8x8S memArg
synInstrToStruct _ (PlainInstr (V128Load8x8U memArg)) = return $ S.V128Load8x8U memArg
synInstrToStruct _ (PlainInstr (V128Load16x4S memArg)) = return $ S.V128Load16x4S memArg
synInstrToStruct _ (PlainInstr (V128Load16x4U memArg)) = return $ S.V128Load16x4U memArg
synInstrToStruct _ (PlainInstr (V128Load32x2S memArg)) = return $ S.V128Load32x2S memArg
synInstrToStruct _ (PlainInstr (V128Load32x2U memArg)) = return $ S.V128Load32x2U 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
src/Language/Wasm/Structure.hs
+6
View File
@@ -171,6 +171,12 @@ data Instruction index =
| V128Load64Splat MemArg
| V128Load32Zero MemArg
| V128Load64Zero MemArg
| V128Load8x8S MemArg
| V128Load8x8U MemArg
| V128Load16x4S MemArg
| V128Load16x4U MemArg
| V128Load32x2S MemArg
| V128Load32x2U MemArg
| I32Load8S MemArg
| I32Load8U MemArg
| I32Load16S MemArg
src/Language/Wasm/Validate.hs
+18
View File
@@ -358,6 +358,24 @@ getInstrType _ (V128Load32Zero memarg) = do
getInstrType _ (V128Load64Zero memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> V128
getInstrType _ (V128Load8x8S memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> V128
getInstrType _ (V128Load8x8U memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> V128
getInstrType _ (V128Load16x4S memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> V128
getInstrType _ (V128Load16x4U memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> V128
getInstrType _ (V128Load32x2S memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> V128
getInstrType _ (V128Load32x2U memarg) = do
checkMemoryInstr 8 memarg
return $ I32 ==> V128
getInstrType _ (I32Load8S memarg) = do
checkMemoryInstr 1 memarg
return $ I32 ==> I32
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_load_extend.wast"]
-- let files = ["simd_load_extend.wast"]
scriptTestCases <- (`mapM` files) $ \file -> do
test <- LBS.readFile ("tests/spec/" ++ file)
return $ testCase file $ do