diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 925d806..0ba466b 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -1410,6 +1410,24 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct let w1 = ByteArray.indexByteArray @Word64 v 1 in let r = ByteArray.byteArrayFromList [complement w0, complement w1] in return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v:rest) } (IUnOp (BS128 shape) INeg) = + let r = case shape of + I8x16 -> ByteArray.byteArrayFromList $ (asWord8 . negate . asInt8) . ByteArray.indexByteArray @Word8 v <$> [0..15] + I16x8 -> ByteArray.byteArrayFromList $ (asWord16 . negate . asInt16) . ByteArray.indexByteArray @Word16 v <$> [0..7] + I32x4 -> ByteArray.byteArrayFromList $ (asWord32 . negate . asInt32) . ByteArray.indexByteArray @Word32 v <$> [0..3] + I64x2 -> ByteArray.byteArrayFromList $ (asWord64 . negate . asInt64) . ByteArray.indexByteArray @Word64 v <$> [0..1] + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v:rest) } (IUnOp (BS128 shape) IAbs) = + let r = case shape of + I8x16 -> ByteArray.byteArrayFromList $ (asWord8 . abs . asInt8) . ByteArray.indexByteArray @Word8 v <$> [0..15] + I16x8 -> ByteArray.byteArrayFromList $ (asWord16 . abs . asInt16) . ByteArray.indexByteArray @Word16 v <$> [0..7] + I32x4 -> ByteArray.byteArrayFromList $ (asWord32 . abs . asInt32) . ByteArray.indexByteArray @Word32 v <$> [0..3] + I64x2 -> ByteArray.byteArrayFromList $ (asWord64 . abs . asInt64) . ByteArray.indexByteArray @Word64 v <$> [0..1] + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 shape) IAdd) = let r = case shape of I8x16 -> lanewise @Word8 shape v1 v2 (+) @@ -1428,6 +1446,80 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct _ -> error "impossible due to validation" in return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 shape) IAddSatU) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> + let i = fromIntegral a in + let j = fromIntegral b in + let r = i + j in + if r >= 0xFF then 0xFF + else asWord8 $ fromIntegral r + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> + let i = fromIntegral a in + let j = fromIntegral b in + let r = i + j in + if r >= 0xFFFF then 0xFFFF + else asWord16 $ fromIntegral r + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 shape) ISubSatU) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> + let i = fromIntegral a in + let j = fromIntegral b in + let r = i - j in + if r >= 0xFF then 0xFF + else if r <= 0 then 0 + else asWord8 $ fromIntegral r + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> + let i = fromIntegral a in + let j = fromIntegral b in + let r = i - j in + if r >= 0xFFFF then 0xFFFF + else if r <= 0 then 0 + else asWord16 $ fromIntegral r + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 shape) IAddSatS) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> + let i = fromIntegral $ asInt8 a in + let j = fromIntegral $ asInt8 b in + let r = i + j in + if r >= 0x7F then 0x7F + else if r <= -0x80 then 0x80 + else asWord8 $ fromIntegral r + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> + let i = fromIntegral $ asInt16 a in + let j = fromIntegral $ asInt16 b in + let r = i + j in + if r >= 0x7FFF then 0x7FFF + else if r < -0x8000 then 0x8000 + else asWord16 $ fromIntegral r + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 shape) ISubSatS) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> + let i = fromIntegral $ asInt8 a in + let j = fromIntegral $ asInt8 b in + let r = i - j in + if r >= 0x7F then 0x7F + else if r <= -0x80 then 0x80 + else asWord8 $ fromIntegral r + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> + let i = fromIntegral $ asInt16 a in + let j = fromIntegral $ asInt16 b in + let r = i - j in + if r >= 0x7FFF then 0x7FFF + else if r < -0x8000 then 0x8000 + else asWord16 $ fromIntegral r + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 _) IAnd) = let r = lanewise @Word64 I64x2 v1 v2 (.&.) in return $ Done ctx { stack = VV128 r : rest } diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index 315177a..1063aa6 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -413,6 +413,22 @@ import Language.Wasm.Lexer ( 'i16x8.sub' { Lexeme _ (TKeyword "i16x8.sub") } 'i32x4.sub' { Lexeme _ (TKeyword "i32x4.sub") } 'i64x2.sub' { Lexeme _ (TKeyword "i64x2.sub") } +'i8x16.add_sat_s' { Lexeme _ (TKeyword "i8x16.add_sat_s") } +'i16x8.add_sat_s' { Lexeme _ (TKeyword "i16x8.add_sat_s") } +'i8x16.sub_sat_s' { Lexeme _ (TKeyword "i8x16.sub_sat_s") } +'i16x8.sub_sat_s' { Lexeme _ (TKeyword "i16x8.sub_sat_s") } +'i8x16.add_sat_u' { Lexeme _ (TKeyword "i8x16.add_sat_u") } +'i16x8.add_sat_u' { Lexeme _ (TKeyword "i16x8.add_sat_u") } +'i8x16.sub_sat_u' { Lexeme _ (TKeyword "i8x16.sub_sat_u") } +'i16x8.sub_sat_u' { Lexeme _ (TKeyword "i16x8.sub_sat_u") } +'i8x16.abs' { Lexeme _ (TKeyword "i8x16.abs") } +'i16x8.abs' { Lexeme _ (TKeyword "i16x8.abs") } +'i32x4.abs' { Lexeme _ (TKeyword "i32x4.abs") } +'i64x2.abs' { Lexeme _ (TKeyword "i64x2.abs") } +'i8x16.neg' { Lexeme _ (TKeyword "i8x16.neg") } +'i16x8.neg' { Lexeme _ (TKeyword "i16x8.neg") } +'i32x4.neg' { Lexeme _ (TKeyword "i32x4.neg") } +'i64x2.neg' { Lexeme _ (TKeyword "i64x2.neg") } 'i8x16.shl' { Lexeme _ (TKeyword "i8x16.shl") } 'i16x8.shl' { Lexeme _ (TKeyword "i16x8.shl") } 'i32x4.shl' { Lexeme _ (TKeyword "i32x4.shl") } @@ -875,6 +891,14 @@ plaininstr :: { PlainInstr } | 'i16x8.sub' { IBinOp (BS128 I16x8) ISub } | 'i32x4.sub' { IBinOp (BS128 I32x4) ISub } | 'i64x2.sub' { IBinOp (BS128 I64x2) ISub } + | 'i8x16.add_sat_s' { IBinOp (BS128 I8x16) IAddSatS } + | 'i16x8.add_sat_s' { IBinOp (BS128 I16x8) IAddSatS } + | 'i8x16.sub_sat_s' { IBinOp (BS128 I8x16) ISubSatS } + | 'i16x8.sub_sat_s' { IBinOp (BS128 I16x8) ISubSatS } + | 'i8x16.add_sat_u' { IBinOp (BS128 I8x16) IAddSatU } + | 'i16x8.add_sat_u' { IBinOp (BS128 I16x8) IAddSatU } + | 'i8x16.sub_sat_u' { IBinOp (BS128 I8x16) ISubSatU } + | 'i16x8.sub_sat_u' { IBinOp (BS128 I16x8) ISubSatU } | 'i8x16.shl' { IBinOp (BS128 I8x16) IShl } | 'i16x8.shl' { IBinOp (BS128 I16x8) IShl } | 'i32x4.shl' { IBinOp (BS128 I32x4) IShl } @@ -887,6 +911,14 @@ plaininstr :: { PlainInstr } | 'i16x8.shr_s' { IBinOp (BS128 I16x8) IShrS } | 'i32x4.shr_s' { IBinOp (BS128 I32x4) IShrS } | 'i64x2.shr_s' { IBinOp (BS128 I64x2) IShrS } + | 'i8x16.abs' { IUnOp (BS128 I8x16) IAbs } + | 'i16x8.abs' { IUnOp (BS128 I16x8) IAbs } + | 'i32x4.abs' { IUnOp (BS128 I32x4) IAbs } + | 'i64x2.abs' { IUnOp (BS128 I64x2) IAbs } + | 'i8x16.neg' { IUnOp (BS128 I8x16) INeg } + | 'i16x8.neg' { IUnOp (BS128 I16x8) INeg } + | 'i32x4.neg' { IUnOp (BS128 I32x4) INeg } + | 'i64x2.neg' { IUnOp (BS128 I64x2) INeg } | 'i8x16.bitmask' { V128BitMask I8x16 } | 'i16x8.bitmask' { V128BitMask I16x8 } | 'i32x4.bitmask' { V128BitMask I32x4 } diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs index 5954edc..d4fb402 100644 --- a/src/Language/Wasm/Structure.hs +++ b/src/Language/Wasm/Structure.hs @@ -72,11 +72,17 @@ data IUnOp = | IExtend16S | IExtend32S | INot + | IAbs + | INeg deriving (Show, Eq, Generic, NFData) data IBinOp = IAdd | ISub + | IAddSatS + | ISubSatS + | IAddSatU + | ISubSatU | IMul | IDivU | IDivS diff --git a/tests/Test.hs b/tests/Test.hs index ec2f356..e12bb7d 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_bit_shift.wast"] + -- let files = ["simd_i8x16_sat_arith.wast"] scriptTestCases <- (`mapM` files) $ \file -> do test <- LBS.readFile ("tests/spec/" ++ file) return $ testCase file $ do