msyds/haskell-wasm
1
0
Fork 0
forked from GitHub/haskell-wasm
Code Pull Requests Activity

implement lanewise integer cmp operations

Browse Source
This commit is contained in:
Ilya Rezvov
2023-09-09 10:22:18 -06:00
parent d98d1b718f
commit 6d6d21265a
4 changed files with 172 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+90
View File
@@ -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) =
src/Language/Wasm/Parser.y
+80
View File
@@ -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)) {
src/Language/Wasm/Validate.hs
+1
View File
@@ -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
tests/Test.hs
+1 -1
View File
@@ -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