diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 50fa7b4..b4be69d 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -1489,6 +1489,12 @@ 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 } + -- SIMD + step ctx@EvalCtx{ stack = (VV128 s:VV128 a:rest) } I8x16Swizzle = + let get i = if i > 15 then 0 else ByteArray.indexByteArray @Word8 a $ fromIntegral i in + let lanes = get . ByteArray.indexByteArray @Word8 s <$> [0..15] in + let val = ByteArray.byteArrayFromListN @Word8 16 lanes in + return $ Done ctx { stack = VV128 val : rest } step ctx@EvalCtx{ stack } (V128Splat shape) = do let (val, rest) = case shape of I8x16 -> @@ -1510,6 +1516,29 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct let (VF64 d:rest) = stack in (ByteArray.byteArrayFromListN @Word64 2 [doubleToWord d, doubleToWord d], rest) return $ Done ctx { stack = VV128 val : rest } + step ctx@EvalCtx{ stack = (VV128 v:rest) } (V128ExtractLane shape idx signed) = do + let val = case shape of + I8x16 -> + let s = if signed + then \i -> if i >= 0x80 then -1 * fromIntegral (0xFF - i + 1) else fromIntegral i + else fromIntegral + in + VI32 $ asWord32 $ s $ ByteArray.indexByteArray @Word8 v (fromIntegral idx) + I16x8 -> + let s = if signed + then \i -> if i >= 0x8000 then -1 * fromIntegral (0xFFFF - i + 1) else fromIntegral i + else fromIntegral + in + VI32 $ asWord32 $ s $ ByteArray.indexByteArray @Word16 v (fromIntegral idx) + I32x4 -> + VI32 $ ByteArray.indexByteArray @Word32 v (fromIntegral idx) + I64x2 -> + VI64 $ ByteArray.indexByteArray @Word64 v (fromIntegral idx) + F32x4 -> + VF32 $ wordToFloat $ ByteArray.indexByteArray @Word32 v (fromIntegral idx) + F64x2 -> + VF64 $ wordToDouble $ ByteArray.indexByteArray @Word64 v (fromIntegral idx) + return $ Done ctx { stack = 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 3b0572e..a9eda38 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -352,12 +352,21 @@ import Language.Wasm.Lexer ( 'start' { Lexeme _ (TKeyword "start") } 'module' { Lexeme _ (TKeyword "module") } -- simd +'i8x16.swizzle' { Lexeme _ (TKeyword "i8x16.swizzle") } '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") } +'i8x16.extract_lane_u'{ Lexeme _ (TKeyword "i8x16.extract_lane_u") } +'i16x8.extract_lane_u'{ Lexeme _ (TKeyword "i16x8.extract_lane_u") } +'i8x16.extract_lane_s'{ Lexeme _ (TKeyword "i8x16.extract_lane_s") } +'i16x8.extract_lane_s'{ Lexeme _ (TKeyword "i16x8.extract_lane_s") } +'i32x4.extract_lane' { Lexeme _ (TKeyword "i32x4.extract_lane") } +'i64x2.extract_lane' { Lexeme _ (TKeyword "i64x2.extract_lane") } +'f32x4.extract_lane' { Lexeme _ (TKeyword "f32x4.extract_lane") } +'f64x2.extract_lane' { Lexeme _ (TKeyword "f64x2.extract_lane") } 'i32x4.add' { Lexeme _ (TKeyword "i32x4.add") } 'i64x2.add' { Lexeme _ (TKeyword "i64x2.add") } -- script extension @@ -704,12 +713,21 @@ plaininstr :: { PlainInstr } | 'f32.reinterpret_i32' { FReinterpretI BS32 } | 'f64.reinterpret_i64' { FReinterpretI BS64 } -- simd + | 'i8x16.swizzle' { I8x16Swizzle } | 'i8x16.splat' { V128Splat I8x16 } | 'i16x8.splat' { V128Splat I16x8 } | 'i32x4.splat' { V128Splat I32x4 } | 'i64x2.splat' { V128Splat I64x2 } | 'f32x4.splat' { V128Splat F32x4 } | 'f64x2.splat' { V128Splat F64x2 } + | 'i8x16.extract_lane_s' u32 { V128ExtractLane I8x16 $2 True } + | 'i16x8.extract_lane_s' u32 { V128ExtractLane I16x8 $2 True } + | 'i8x16.extract_lane_u' u32 { V128ExtractLane I8x16 $2 False } + | 'i16x8.extract_lane_u' u32 { V128ExtractLane I16x8 $2 False } + | 'i32x4.extract_lane' u32 { V128ExtractLane I32x4 $2 False } + | 'i64x2.extract_lane' u32 { V128ExtractLane I64x2 $2 False } + | 'f32x4.extract_lane' u32 { V128ExtractLane F32x4 $2 False } + | 'f64x2.extract_lane' u32 { V128ExtractLane F64x2 $2 False } | 'i32x4.add' { IBinOp (BS128 I32x4) IAdd } | 'i64x2.add' { IBinOp (BS128 I64x2) IAdd } @@ -1414,6 +1432,8 @@ data PlainInstr = | FReinterpretI BitSize -- Vector instructions | V128Splat SimdShape + | V128ExtractLane SimdShape Natural Bool + | I8x16Swizzle deriving (Show, Eq) data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq) @@ -1968,6 +1988,8 @@ desugarize fields = do 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 _ (PlainInstr (V128ExtractLane shape idx sign)) = return $ S.V128ExtractLane shape idx sign + synInstrToStruct _ (PlainInstr I8x16Swizzle) = return $ S.I8x16Swizzle 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 8b60e19..196dc35 100644 --- a/src/Language/Wasm/Structure.hs +++ b/src/Language/Wasm/Structure.hs @@ -229,6 +229,8 @@ data Instruction index = | FReinterpretI BitSize -- Vector instructions | V128Splat SimdShape + | V128ExtractLane SimdShape index {- signed -} Bool + | I8x16Swizzle deriving (Show, Eq, Generic, NFData) type Expression = [Instruction Natural] diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index c5bedce..185c5d5 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -522,16 +522,20 @@ 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 +getInstrType _ I8x16Swizzle = + return $ [V128, V128] ==> V128 +getInstrType _ (V128Splat shape) = + return $ getShapeElemType shape ==> V128 +getInstrType _ (V128ExtractLane shape _ _) = + return $ V128 ==> getShapeElemType shape +getShapeElemType :: SimdShape -> ValueType +getShapeElemType I8x16 = I32 +getShapeElemType I16x8 = I32 +getShapeElemType I32x4 = I32 +getShapeElemType I64x2 = I64 +getShapeElemType F32x4 = F32 +getShapeElemType F64x2 = F64 replace :: (Eq a) => a -> a -> [a] -> [a] replace _ _ [] = []