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

implement int bin operations

Browse Source
This commit is contained in:
Ilya Rezvov
2018-03-15 20:53:45 -07:00
parent d5324acb40
commit 36225ea479
1 changed files with 84 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+84
View File
@@ -16,9 +16,11 @@ import qualified Data.Vector as Vector
import qualified Data.Vector.Storable.Mutable as IOVector
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Word (Word8, Word32, Word64)
import Data.Int (Int32, Int64)
import Numeric.Natural (Natural)
import qualified Control.Monad as Monad
import Data.Monoid ((<>))
import Data.Bits ((.|.), (.&.), xor, shiftL, shiftR, rotateL, rotateR)
import Language.Wasm.Structure as Struct
@@ -29,6 +31,28 @@ data Value =
| VF64 Double
deriving (Eq, Show)
asInt32 :: Word32 -> Int32
asInt32 w =
let base = fromIntegral $ w .&. 0x7FFFFFFF in
let sign = w .&. 0x80000000 in
if sign /= 0 then -base else base
asInt64 :: Word64 -> Int64
asInt64 w =
let base = fromIntegral $ w .&. 0x7FFFFFFFFFFFFFFF in
let sign = w .&. 0x8000000000000000 in
if sign /= 0 then -base else base
asWord32 :: Int32 -> Word32
asWord32 i
| i >= 0 = fromIntegral i
| otherwise = 0x80000000 .|. (fromIntegral (abs i))
asWord64 :: Int64 -> Word64
asWord64 i
| i >= 0 = fromIntegral i
| otherwise = 0x8000000000000000 .|. (fromIntegral (abs i))
data Label = Label ResultType deriving (Show, Eq)
type Address = Int
@@ -379,6 +403,66 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
step ctx (I64Const v) = return $ Done ctx { stack = VI64 v : stack ctx }
step ctx (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx }
step ctx (F64Const v) = return $ Done ctx { stack = VF64 v : stack ctx }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IAdd) =
return $ Done ctx { stack = VI32 (v1 + v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 ISub) =
return $ Done ctx { stack = VI32 (v1 - v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IMul) =
return $ Done ctx { stack = VI32 (v1 * v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IDivU) =
return $ Done ctx { stack = VI32 (v1 `div` v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IDivS) =
return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 `div` asInt32 v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IRemU) =
return $ Done ctx { stack = VI32 (v1 `rem` v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IRemS) =
return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 `rem` asInt32 v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IAnd) =
return $ Done ctx { stack = VI32 (v1 .&. v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IOr) =
return $ Done ctx { stack = VI32 (v1 .|. v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IXor) =
return $ Done ctx { stack = VI32 (v1 `xor` v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IShl) =
return $ Done ctx { stack = VI32 (v1 `shiftL` fromIntegral v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IShrU) =
return $ Done ctx { stack = VI32 (v1 `shiftR` fromIntegral v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IShrS) =
return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 `shiftR` (fromIntegral $ asInt32 v2)) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IRotl) =
return $ Done ctx { stack = VI32 (v1 `rotateL` fromIntegral v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v1:VI32 v2:rest) } (IBinOp BS32 IRotr) =
return $ Done ctx { stack = VI32 (v1 `rotateR` fromIntegral v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IAdd) =
return $ Done ctx { stack = VI64 (v1 + v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 ISub) =
return $ Done ctx { stack = VI64 (v1 - v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IMul) =
return $ Done ctx { stack = VI64 (v1 * v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IDivU) =
return $ Done ctx { stack = VI64 (v1 `div` v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IDivS) =
return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `div` asInt64 v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IRemU) =
return $ Done ctx { stack = VI64 (v1 `rem` v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IRemS) =
return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `rem` asInt64 v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IAnd) =
return $ Done ctx { stack = VI64 (v1 .&. v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IOr) =
return $ Done ctx { stack = VI64 (v1 .|. v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IXor) =
return $ Done ctx { stack = VI64 (v1 `xor` v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IShl) =
return $ Done ctx { stack = VI64 (v1 `shiftL` fromIntegral v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IShrU) =
return $ Done ctx { stack = VI64 (v1 `shiftR` fromIntegral v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IShrS) =
return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `shiftR` (fromIntegral $ asInt64 v2)) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IRotl) =
return $ Done ctx { stack = VI64 (v1 `rotateL` fromIntegral v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v1:VI64 v2:rest) } (IBinOp BS64 IRotr) =
return $ Done ctx { stack = VI64 (v1 `rotateR` fromIntegral v2) : rest }
step _ instr = error $ "Error during evaluation of instruction " ++ show instr
eval store HostInstance { funcType, tag } args = return args