diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 69c1e9d..dfcecd2 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -1564,6 +1564,96 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct I64x2 -> ByteArray.byteArrayFromList $ (asWord64 . (`shiftR` (fromIntegral s `rem` 64)) . asInt64) . ByteArray.indexByteArray @Word64 v <$> [0..1] in return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) IEq) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if a == b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if a == b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if a == b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if a == b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) INe) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if a /= b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if a /= b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if a /= b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if a /= b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) ILtU) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if a < b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if a < b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if a < b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if a < b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) ILtS) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if asInt8 a < asInt8 b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if asInt16 a < asInt16 b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if asInt32 a < asInt32 b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if asInt64 a < asInt64 b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) IGtU) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if a > b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if a > b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if a > b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if a > b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) IGtS) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if asInt8 a > asInt8 b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if asInt16 a > asInt16 b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if asInt32 a > asInt32 b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if asInt64 a > asInt64 b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) ILeU) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if a <= b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if a <= b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if a <= b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if a <= b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) ILeS) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if asInt8 a <= asInt8 b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if asInt16 a <= asInt16 b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if asInt32 a <= asInt32 b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if asInt64 a <= asInt64 b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) IGeU) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if a >= b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if a >= b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if a >= b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if a >= b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } + step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IRelOp (BS128 shape) IGeS) = + let r = case shape of + I8x16 -> lanewise @Word8 shape v1 v2 $ \a b -> if asInt8 a >= asInt8 b then fromIntegral (-1) else 0 + I16x8 -> lanewise @Word16 shape v1 v2 $ \a b -> if asInt16 a >= asInt16 b then fromIntegral (-1) else 0 + I32x4 -> lanewise @Word32 shape v1 v2 $ \a b -> if asInt32 a >= asInt32 b then fromIntegral (-1) else 0 + I64x2 -> lanewise @Word64 shape v1 v2 $ \a b -> if asInt64 a >= asInt64 b then fromIntegral (-1) else 0 + _ -> error "impossible due to validation" + in + return $ Done ctx { stack = VV128 r : rest } step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FAbs) = return $ Done ctx { stack = VF32 (abs v) : rest } step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNeg) = diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index 0740846..8ca9181 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -448,6 +448,46 @@ import Language.Wasm.Lexer ( 'i16x8.bitmask' { Lexeme _ (TKeyword "i16x8.bitmask") } 'i32x4.bitmask' { Lexeme _ (TKeyword "i32x4.bitmask") } 'i64x2.bitmask' { Lexeme _ (TKeyword "i64x2.bitmask") } +'i8x16.eq' { Lexeme _ (TKeyword "i8x16.eq") } +'i16x8.eq' { Lexeme _ (TKeyword "i16x8.eq") } +'i32x4.eq' { Lexeme _ (TKeyword "i32x4.eq") } +'i64x2.eq' { Lexeme _ (TKeyword "i64x2.eq") } +'i8x16.ne' { Lexeme _ (TKeyword "i8x16.ne") } +'i16x8.ne' { Lexeme _ (TKeyword "i16x8.ne") } +'i32x4.ne' { Lexeme _ (TKeyword "i32x4.ne") } +'i64x2.ne' { Lexeme _ (TKeyword "i64x2.ne") } +'i8x16.lt_s' { Lexeme _ (TKeyword "i8x16.lt_s") } +'i16x8.lt_s' { Lexeme _ (TKeyword "i16x8.lt_s") } +'i32x4.lt_s' { Lexeme _ (TKeyword "i32x4.lt_s") } +'i64x2.lt_s' { Lexeme _ (TKeyword "i64x2.lt_s") } +'i8x16.lt_u' { Lexeme _ (TKeyword "i8x16.lt_u") } +'i16x8.lt_u' { Lexeme _ (TKeyword "i16x8.lt_u") } +'i32x4.lt_u' { Lexeme _ (TKeyword "i32x4.lt_u") } +'i64x2.lt_u' { Lexeme _ (TKeyword "i64x2.lt_u") } +'i8x16.le_s' { Lexeme _ (TKeyword "i8x16.le_s") } +'i16x8.le_s' { Lexeme _ (TKeyword "i16x8.le_s") } +'i32x4.le_s' { Lexeme _ (TKeyword "i32x4.le_s") } +'i64x2.le_s' { Lexeme _ (TKeyword "i64x2.le_s") } +'i8x16.le_u' { Lexeme _ (TKeyword "i8x16.le_u") } +'i16x8.le_u' { Lexeme _ (TKeyword "i16x8.le_u") } +'i32x4.le_u' { Lexeme _ (TKeyword "i32x4.le_u") } +'i64x2.le_u' { Lexeme _ (TKeyword "i64x2.le_u") } +'i8x16.gt_s' { Lexeme _ (TKeyword "i8x16.gt_s") } +'i16x8.gt_s' { Lexeme _ (TKeyword "i16x8.gt_s") } +'i32x4.gt_s' { Lexeme _ (TKeyword "i32x4.gt_s") } +'i64x2.gt_s' { Lexeme _ (TKeyword "i64x2.gt_s") } +'i8x16.gt_u' { Lexeme _ (TKeyword "i8x16.gt_u") } +'i16x8.gt_u' { Lexeme _ (TKeyword "i16x8.gt_u") } +'i32x4.gt_u' { Lexeme _ (TKeyword "i32x4.gt_u") } +'i64x2.gt_u' { Lexeme _ (TKeyword "i64x2.gt_u") } +'i8x16.ge_s' { Lexeme _ (TKeyword "i8x16.ge_s") } +'i16x8.ge_s' { Lexeme _ (TKeyword "i16x8.ge_s") } +'i32x4.ge_s' { Lexeme _ (TKeyword "i32x4.ge_s") } +'i64x2.ge_s' { Lexeme _ (TKeyword "i64x2.ge_s") } +'i8x16.ge_u' { Lexeme _ (TKeyword "i8x16.ge_u") } +'i16x8.ge_u' { Lexeme _ (TKeyword "i16x8.ge_u") } +'i32x4.ge_u' { Lexeme _ (TKeyword "i32x4.ge_u") } +'i64x2.ge_u' { Lexeme _ (TKeyword "i64x2.ge_u") } -- script extension 'binary' { Lexeme _ (TKeyword "binary") } 'quote' { Lexeme _ (TKeyword "quote") } @@ -929,6 +969,46 @@ plaininstr :: { PlainInstr } | 'i16x8.bitmask' { V128BitMask I16x8 } | 'i32x4.bitmask' { V128BitMask I32x4 } | 'i64x2.bitmask' { V128BitMask I64x2 } + | 'i8x16.eq' { IRelOp (BS128 I8x16) IEq } + | 'i16x8.eq' { IRelOp (BS128 I16x8) IEq } + | 'i32x4.eq' { IRelOp (BS128 I32x4) IEq } + | 'i64x2.eq' { IRelOp (BS128 I64x2) IEq } + | 'i8x16.ne' { IRelOp (BS128 I8x16) INe } + | 'i16x8.ne' { IRelOp (BS128 I16x8) INe } + | 'i32x4.ne' { IRelOp (BS128 I32x4) INe } + | 'i64x2.ne' { IRelOp (BS128 I64x2) INe } + | 'i8x16.lt_s' { IRelOp (BS128 I8x16) ILtS } + | 'i16x8.lt_s' { IRelOp (BS128 I16x8) ILtS } + | 'i32x4.lt_s' { IRelOp (BS128 I32x4) ILtS } + | 'i64x2.lt_s' { IRelOp (BS128 I64x2) ILtS } + | 'i8x16.lt_u' { IRelOp (BS128 I8x16) ILtU } + | 'i16x8.lt_u' { IRelOp (BS128 I16x8) ILtU } + | 'i32x4.lt_u' { IRelOp (BS128 I32x4) ILtU } + | 'i64x2.lt_u' { IRelOp (BS128 I64x2) ILtU } + | 'i8x16.le_s' { IRelOp (BS128 I8x16) ILeS } + | 'i16x8.le_s' { IRelOp (BS128 I16x8) ILeS } + | 'i32x4.le_s' { IRelOp (BS128 I32x4) ILeS } + | 'i64x2.le_s' { IRelOp (BS128 I64x2) ILeS } + | 'i8x16.le_u' { IRelOp (BS128 I8x16) ILeU } + | 'i16x8.le_u' { IRelOp (BS128 I16x8) ILeU } + | 'i32x4.le_u' { IRelOp (BS128 I32x4) ILeU } + | 'i64x2.le_u' { IRelOp (BS128 I64x2) ILeU } + | 'i8x16.gt_s' { IRelOp (BS128 I8x16) IGtS } + | 'i16x8.gt_s' { IRelOp (BS128 I16x8) IGtS } + | 'i32x4.gt_s' { IRelOp (BS128 I32x4) IGtS } + | 'i64x2.gt_s' { IRelOp (BS128 I64x2) IGtS } + | 'i8x16.gt_u' { IRelOp (BS128 I8x16) IGtU } + | 'i16x8.gt_u' { IRelOp (BS128 I16x8) IGtU } + | 'i32x4.gt_u' { IRelOp (BS128 I32x4) IGtU } + | 'i64x2.gt_u' { IRelOp (BS128 I64x2) IGtU } + | 'i8x16.ge_s' { IRelOp (BS128 I8x16) IGeS } + | 'i16x8.ge_s' { IRelOp (BS128 I16x8) IGeS } + | 'i32x4.ge_s' { IRelOp (BS128 I32x4) IGeS } + | 'i64x2.ge_s' { IRelOp (BS128 I64x2) IGeS } + | 'i8x16.ge_u' { IRelOp (BS128 I8x16) IGeU } + | 'i16x8.ge_u' { IRelOp (BS128 I16x8) IGeU } + | 'i32x4.ge_u' { IRelOp (BS128 I32x4) IGeU } + | 'i64x2.ge_u' { IRelOp (BS128 I64x2) IGeU } typeuse(next) : '(' typeuse1(folded_instr_list(next), instruction_list(next)) { diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index 0f572b0..552907a 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -555,6 +555,7 @@ getInstrType _ I32Eqz = return $ I32 ==> I32 getInstrType _ I64Eqz = return $ I64 ==> I32 getInstrType _ (IRelOp BS32 _) = return $ [I32, I32] ==> I32 getInstrType _ (IRelOp BS64 _) = return $ [I64, I64] ==> I32 +getInstrType _ (IRelOp (BS128 _) _) = return $ [V128, V128] ==> V128 getInstrType _ (FUnOp BS32 _) = return $ F32 ==> F32 getInstrType _ (FUnOp BS64 _) = return $ F64 ==> F64 getInstrType _ (FBinOp BS32 _) = return $ [F32, F32] ==> F32 diff --git a/tests/Test.hs b/tests/Test.hs index ea4e84a..e1f1669 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_i16x8_cmp.wast"] + -- let files = ["simd_i16x8_cmp.wast"] scriptTestCases <- (`mapM` files) $ \file -> do test <- LBS.readFile ("tests/spec/" ++ file) return $ testCase file $ do