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

saturated ops, neg and abs

Browse Source
This commit is contained in:
Ilya Rezvov
2023-09-08 22:30:37 -06:00
parent 707288debd
commit 369cad8a25
4 changed files with 131 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+92
View File
@@ -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 }
src/Language/Wasm/Parser.y
+32
View File
@@ -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 }
src/Language/Wasm/Structure.hs
+6
View File
@@ -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
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_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