From daa52f0c40261a931602ab36c9ebb6826c2f5291 Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Mon, 4 Sep 2023 19:18:09 -0600 Subject: [PATCH] implement v128_splat instruction --- src/Language/Wasm/Interpreter.hs | 26 ++++++++++++++++++++++++-- src/Language/Wasm/Parser.y | 15 +++++++++++++++ src/Language/Wasm/Structure.hs | 2 ++ src/Language/Wasm/Validate.hs | 9 +++++++++ tests/Test.hs | 2 +- 5 files changed, 51 insertions(+), 3 deletions(-) diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 5dc1a8f..50fa7b4 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -688,6 +688,7 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct initLocal I64 = VI64 0 initLocal F32 = VF32 0 initLocal F64 = VF64 0 + initLocal V128 = VV128 $ ByteArray.byteArrayFromListN @Word64 2 [0, 0] go :: EvalCtx -> Expression -> IO EvalResult go ctx [] = return $ Done ctx @@ -720,7 +721,7 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct makeStoreInstr ctx@EvalCtx{ stack = (VI32 va:rest) } offset byteWidth v = do let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0) memory <- readIORef memoryRef - let addr = fromIntegral $ va + fromIntegral offset + let addr = fromIntegral va + fromIntegral offset let writeByte idx = do let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF ByteArray.writeByteArray @Word8 memory (addr + idx) byte @@ -919,7 +920,7 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct 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 + let addr = fromIntegral va + fromIntegral offset len <- ByteArray.getSizeofMutableByteArray memory if addr + 16 > len then return Trap @@ -1488,6 +1489,27 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct return $ Done ctx { stack = VF32 (wordToFloat v) : rest } step ctx@EvalCtx{ stack = (VI64 v:rest) } (FReinterpretI BS64) = return $ Done ctx { stack = VF64 (wordToDouble v) : rest } + step ctx@EvalCtx{ stack } (V128Splat shape) = do + let (val, rest) = case shape of + I8x16 -> + let (VI32 v:rest) = stack in + (ByteArray.byteArrayFromListN @Word8 16 $ take 16 $ repeat $ fromIntegral $ asInt32 v, rest) + I16x8 -> + let (VI32 v:rest) = stack in + (ByteArray.byteArrayFromListN @Word16 8 $ take 8 $ repeat $ fromIntegral $ asInt32 v, rest) + I32x4 -> + let (VI32 v:rest) = stack in + (ByteArray.byteArrayFromListN @Word32 4 $ take 4 $ repeat v, rest) + I64x2 -> + let (VI64 v:rest) = stack in + (ByteArray.byteArrayFromListN @Word64 2 [v, v], rest) + F32x4 -> + let (VF32 f:rest) = stack in + (ByteArray.byteArrayFromListN @Word32 4 $ take 4 $ repeat $ floatToWord f, rest) + F64x2 -> + let (VF64 d:rest) = stack in + (ByteArray.byteArrayFromListN @Word64 2 [doubleToWord d, doubleToWord d], rest) + return $ Done ctx { stack = VV128 val : rest } step EvalCtx{ stack } instr = error $ "Error during evaluation of instruction: " ++ show instr ++ ". Stack " ++ show stack eval _ _ _ HostInstance { funcType, hostCode } args = Just <$> hostCode args diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index 661c546..3b0572e 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -352,6 +352,12 @@ import Language.Wasm.Lexer ( 'start' { Lexeme _ (TKeyword "start") } 'module' { Lexeme _ (TKeyword "module") } -- simd +'i8x16.splat' { Lexeme _ (TKeyword "i8x16.splat") } +'i16x8.splat' { Lexeme _ (TKeyword "i16x8.splat") } +'i32x4.splat' { Lexeme _ (TKeyword "i32x4.splat") } +'i64x2.splat' { Lexeme _ (TKeyword "i64x2.splat") } +'f32x4.splat' { Lexeme _ (TKeyword "f32x4.splat") } +'f64x2.splat' { Lexeme _ (TKeyword "f64x2.splat") } 'i32x4.add' { Lexeme _ (TKeyword "i32x4.add") } 'i64x2.add' { Lexeme _ (TKeyword "i64x2.add") } -- script extension @@ -698,6 +704,12 @@ plaininstr :: { PlainInstr } | 'f32.reinterpret_i32' { FReinterpretI BS32 } | 'f64.reinterpret_i64' { FReinterpretI BS64 } -- simd + | 'i8x16.splat' { V128Splat I8x16 } + | 'i16x8.splat' { V128Splat I16x8 } + | 'i32x4.splat' { V128Splat I32x4 } + | 'i64x2.splat' { V128Splat I64x2 } + | 'f32x4.splat' { V128Splat F32x4 } + | 'f64x2.splat' { V128Splat F64x2 } | 'i32x4.add' { IBinOp (BS128 I32x4) IAdd } | 'i64x2.add' { IBinOp (BS128 I64x2) IAdd } @@ -1400,6 +1412,8 @@ data PlainInstr = | F64PromoteF32 | IReinterpretF BitSize | FReinterpretI BitSize + -- Vector instructions + | V128Splat SimdShape deriving (Show, Eq) data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq) @@ -1953,6 +1967,7 @@ desugarize fields = do synInstrToStruct _ (PlainInstr F64PromoteF32) = return $ S.F64PromoteF32 synInstrToStruct _ (PlainInstr (IReinterpretF sz)) = return $ S.IReinterpretF sz synInstrToStruct _ (PlainInstr (FReinterpretI sz)) = return $ S.FReinterpretI sz + synInstrToStruct _ (PlainInstr (V128Splat shape)) = return $ S.V128Splat shape synInstrToStruct ctx@FunCtx { ctxMod = Module { types } } BlockInstr {label, blockType, body} = do let ctx' = ctx { ctxLabels = label : ctxLabels ctx } bt <- case blockType of diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs index 0a00a94..8b60e19 100644 --- a/src/Language/Wasm/Structure.hs +++ b/src/Language/Wasm/Structure.hs @@ -227,6 +227,8 @@ data Instruction index = | F64PromoteF32 | IReinterpretF BitSize | FReinterpretI BitSize + -- Vector instructions + | V128Splat SimdShape deriving (Show, Eq, Generic, NFData) type Expression = [Instruction Natural] diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index e661fb8..c5bedce 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -522,6 +522,15 @@ getInstrType _ (IReinterpretF BS32) = return $ F32 ==> I32 getInstrType _ (IReinterpretF BS64) = return $ F64 ==> I64 getInstrType _ (FReinterpretI BS32) = return $ I32 ==> F32 getInstrType _ (FReinterpretI BS64) = return $ I64 ==> F64 +getInstrType _ (V128Splat shape) = do + let vt = case shape of + I8x16 -> I32 + I16x8 -> I32 + I32x4 -> I32 + I64x2 -> I64 + F32x4 -> F32 + F64x2 -> F64 + return $ vt ==> V128 replace :: (Eq a) => a -> a -> [a] -> [a] diff --git a/tests/Test.hs b/tests/Test.hs index 15eec49..25a5f70 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_store.wast"] + let files = ["simd_splat.wast"] scriptTestCases <- (`mapM` files) $ \file -> do test <- LBS.readFile ("tests/spec/" ++ file) return $ testCase file $ do