GitHub/haskell-wasm
1
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

implement bit shift operations

Browse Source
This commit is contained in:
Ilya Rezvov
2023-09-08 21:44:02 -06:00
parent d25e96d91c
commit 707288debd
4 changed files with 73 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+46 -1
View File
@@ -41,7 +41,7 @@ import qualified Data.Primitive.Types as Primitive
import qualified Control.Monad.Primitive as Primitive
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Word (Word8, Word16, Word32, Word64)
import Data.Int (Int32, Int64)
import Data.Int (Int8, Int16, Int32, Int64)
import Numeric.Natural (Natural)
import qualified Control.Monad as Monad
import Data.Bits (
@@ -84,6 +84,17 @@ data Value =
| RE (Maybe Natural)
deriving (Eq, Show)
asInt8 :: Word8 -> Int8
asInt8 w =
if w < 0x80
then fromIntegral w
else -1 * fromIntegral (0xFF - w + 1)
asInt16 :: Word16 -> Int16
asInt16 w =
if w < 0x8000
then fromIntegral w
else -1 * fromIntegral (0xFFFF - w + 1)
asInt32 :: Word32 -> Int32
asInt32 w =
@@ -97,6 +108,16 @@ asInt64 w =
then fromIntegral w
else -1 * fromIntegral (0xFFFFFFFFFFFFFFFF - w + 1)
asWord8 :: Int8 -> Word8
asWord8 i
| i >= 0 = fromIntegral i
| otherwise = 0xFF - (fromIntegral (abs i)) + 1
asWord16 :: Int16 -> Word16
asWord16 i
| i >= 0 = fromIntegral i
| otherwise = 0xFFFF - (fromIntegral (abs i)) + 1
asWord32 :: Int32 -> Word32
asWord32 i
| i >= 0 = fromIntegral i
@@ -1419,6 +1440,30 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 _) IXor) =
let r = lanewise @Word64 I64x2 v1 v2 xor in
return $ Done ctx { stack = VV128 r : rest }
step ctx@EvalCtx{ stack = (VI32 s:VV128 v:rest) } (IBinOp (BS128 shape) IShl) =
let r = case shape of
I8x16 -> ByteArray.byteArrayFromList $ (`shiftL` (fromIntegral s `rem` 8)) . ByteArray.indexByteArray @Word8 v <$> [0..15]
I16x8 -> ByteArray.byteArrayFromList $ (`shiftL` (fromIntegral s `rem` 16)) . ByteArray.indexByteArray @Word16 v <$> [0..7]
I32x4 -> ByteArray.byteArrayFromList $ (`shiftL` (fromIntegral s `rem` 32)) . ByteArray.indexByteArray @Word32 v <$> [0..3]
I64x2 -> ByteArray.byteArrayFromList $ (`shiftL` (fromIntegral s `rem` 64)) . ByteArray.indexByteArray @Word64 v <$> [0..1]
in
return $ Done ctx { stack = VV128 r : rest }
step ctx@EvalCtx{ stack = (VI32 s:VV128 v:rest) } (IBinOp (BS128 shape) IShrU) =
let r = case shape of
I8x16 -> ByteArray.byteArrayFromList $ (`shiftR` (fromIntegral s `rem` 8)) . ByteArray.indexByteArray @Word8 v <$> [0..15]
I16x8 -> ByteArray.byteArrayFromList $ (`shiftR` (fromIntegral s `rem` 16)) . ByteArray.indexByteArray @Word16 v <$> [0..7]
I32x4 -> ByteArray.byteArrayFromList $ (`shiftR` (fromIntegral s `rem` 32)) . ByteArray.indexByteArray @Word32 v <$> [0..3]
I64x2 -> ByteArray.byteArrayFromList $ (`shiftR` (fromIntegral s `rem` 64)) . ByteArray.indexByteArray @Word64 v <$> [0..1]
in
return $ Done ctx { stack = VV128 r : rest }
step ctx@EvalCtx{ stack = (VI32 s:VV128 v:rest) } (IBinOp (BS128 shape) IShrS) =
let r = case shape of
I8x16 -> ByteArray.byteArrayFromList $ (asWord8 . (`shiftR` (fromIntegral s `rem` 8)) . asInt8) . ByteArray.indexByteArray @Word8 v <$> [0..15]
I16x8 -> ByteArray.byteArrayFromList $ (asWord16 . (`shiftR` (fromIntegral s `rem` 16)) . asInt16) . ByteArray.indexByteArray @Word16 v <$> [0..7]
I32x4 -> ByteArray.byteArrayFromList $ (asWord32 . (`shiftR` (fromIntegral s `rem` 32)) . asInt32) . ByteArray.indexByteArray @Word32 v <$> [0..3]
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 = (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
+24
View File
@@ -413,6 +413,18 @@ import Language.Wasm.Lexer (
'i16x8.sub' { Lexeme _ (TKeyword "i16x8.sub") }
'i32x4.sub' { Lexeme _ (TKeyword "i32x4.sub") }
'i64x2.sub' { Lexeme _ (TKeyword "i64x2.sub") }
'i8x16.shl' { Lexeme _ (TKeyword "i8x16.shl") }
'i16x8.shl' { Lexeme _ (TKeyword "i16x8.shl") }
'i32x4.shl' { Lexeme _ (TKeyword "i32x4.shl") }
'i64x2.shl' { Lexeme _ (TKeyword "i64x2.shl") }
'i8x16.shr_u' { Lexeme _ (TKeyword "i8x16.shr_u") }
'i16x8.shr_u' { Lexeme _ (TKeyword "i16x8.shr_u") }
'i32x4.shr_u' { Lexeme _ (TKeyword "i32x4.shr_u") }
'i64x2.shr_u' { Lexeme _ (TKeyword "i64x2.shr_u") }
'i8x16.shr_s' { Lexeme _ (TKeyword "i8x16.shr_s") }
'i16x8.shr_s' { Lexeme _ (TKeyword "i16x8.shr_s") }
'i32x4.shr_s' { Lexeme _ (TKeyword "i32x4.shr_s") }
'i64x2.shr_s' { Lexeme _ (TKeyword "i64x2.shr_s") }
'i8x16.bitmask' { Lexeme _ (TKeyword "i8x16.bitmask") }
'i16x8.bitmask' { Lexeme _ (TKeyword "i16x8.bitmask") }
'i32x4.bitmask' { Lexeme _ (TKeyword "i32x4.bitmask") }
@@ -863,6 +875,18 @@ plaininstr :: { PlainInstr }
| 'i16x8.sub' { IBinOp (BS128 I16x8) ISub }
| 'i32x4.sub' { IBinOp (BS128 I32x4) ISub }
| 'i64x2.sub' { IBinOp (BS128 I64x2) ISub }
| 'i8x16.shl' { IBinOp (BS128 I8x16) IShl }
| 'i16x8.shl' { IBinOp (BS128 I16x8) IShl }
| 'i32x4.shl' { IBinOp (BS128 I32x4) IShl }
| 'i64x2.shl' { IBinOp (BS128 I64x2) IShl }
| 'i8x16.shr_u' { IBinOp (BS128 I8x16) IShrU }
| 'i16x8.shr_u' { IBinOp (BS128 I16x8) IShrU }
| 'i32x4.shr_u' { IBinOp (BS128 I32x4) IShrU }
| 'i64x2.shr_u' { IBinOp (BS128 I64x2) IShrU }
| 'i8x16.shr_s' { IBinOp (BS128 I8x16) IShrS }
| 'i16x8.shr_s' { IBinOp (BS128 I16x8) IShrS }
| 'i32x4.shr_s' { IBinOp (BS128 I32x4) IShrS }
| 'i64x2.shr_s' { IBinOp (BS128 I64x2) IShrS }
| 'i8x16.bitmask' { V128BitMask I8x16 }
| 'i16x8.bitmask' { V128BitMask I16x8 }
| 'i32x4.bitmask' { V128BitMask I32x4 }
src/Language/Wasm/Validate.hs
+2
View File
@@ -548,6 +548,8 @@ getInstrType _ (IUnOp BS64 _) = return $ I64 ==> I64
getInstrType _ (IUnOp (BS128 _) _) = return $ V128 ==> V128
getInstrType _ (IBinOp BS32 _) = return $ [I32, I32] ==> I32
getInstrType _ (IBinOp BS64 _) = return $ [I64, I64] ==> I64
getInstrType _ (IBinOp (BS128 _) op) | op == IShl || op == IShrS || op == IShrU =
return $ [V128, I32] ==> V128
getInstrType _ (IBinOp (BS128 _) _) = return $ [V128, V128] ==> V128
getInstrType _ I32Eqz = return $ I32 ==> I32
getInstrType _ I64Eqz = return $ I64 ==> I32