implement v128_splat instruction

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
 

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

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]

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]

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