{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{- |
Executing one instruction at a time.
-}
module Wrench.Isa.Wasm32.Execute () where

import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.String.Interpolate (i)
import Relude
import Wrench.Isa.Wasm32.Instruction
import Wrench.Isa.Wasm32.State
import Wrench.Machine.BitPack (unpackWords)
import Wrench.Machine.Memory
import Wrench.Machine.Types

instance (IsWord w) => InitState (Wasm32St w) where
    initState :: Int -> MemOf (Wasm32St w) -> StdGen -> Wasm32St w
initState Int
pc MemOf (Wasm32St w)
dump StdGen
_randomGen =
        Wasm32St
            { Int
pc :: Int
pc :: Int
pc
            , sp :: Int
sp = IoMem (Wasm32Isa w w) w -> Int
forall w. IoMem (Wasm32Isa w w) w -> Int
defaultStackRoot IoMem (Wasm32Isa w w) w
MemOf (Wasm32St w)
dump
            , stackRoot :: Int
stackRoot = IoMem (Wasm32Isa w w) w -> Int
forall w. IoMem (Wasm32Isa w w) w -> Int
defaultStackRoot IoMem (Wasm32Isa w w) w
MemOf (Wasm32St w)
dump
            , scanCache :: [(Int, Int)]
scanCache = []
            , scanCacheSize :: Int
scanCacheSize = Int
4
            , branchCache :: [BranchEntry w]
branchCache = []
            , branchCacheSize :: Int
branchCacheSize = Int
4
            , tosRegs :: [(Int, w)]
tosRegs = []
            , tosRegCount :: Int
tosRegCount = Int
2
            , ctrlSp :: Int
ctrlSp = IoMem (Wasm32Isa w w) w -> Int
forall w. IoMem (Wasm32Isa w w) w -> Int
defaultStackRoot IoMem (Wasm32Isa w w) w
MemOf (Wasm32St w)
dump
            , frameBase :: Int
frameBase = IoMem (Wasm32Isa w w) w -> Int
forall w. IoMem (Wasm32Isa w w) w -> Int
defaultStackRoot IoMem (Wasm32Isa w w) w
MemOf (Wasm32St w)
dump Int -> Int -> Int
forall a. Num a => a -> a -> a
- forall t. ByteSizeT t => Int
byteSizeT @w
            , localCount :: Int
localCount = Int
0
            , mem :: IoMem (Wasm32Isa w w) w
mem = IoMem (Wasm32Isa w w) w
MemOf (Wasm32St w)
dump
            , ir :: [(Int, Wasm32Isa w w)]
ir = []
            , stopped :: Bool
stopped = Bool
False
            , internalError :: Maybe Text
internalError = Maybe Text
forall a. Maybe a
Nothing
            }

afterMatchingEnd ::
    (IsWord w) => Int -> Wasm32Isa w w -> (Int -> State (Wasm32St w) ()) -> State (Wasm32St w) ()
afterMatchingEnd :: forall w.
IsWord w =>
Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
afterMatchingEnd Int
pc Wasm32Isa w w
opener Int -> State (Wasm32St w) ()
f =
    Bool
-> Int -> Wasm32Isa w w -> State (Wasm32St w) (Either Text Int)
forall w.
IsWord w =>
Bool
-> Int -> Wasm32Isa w w -> State (Wasm32St w) (Either Text Int)
matchElseOrEnd Bool
False Int
pc Wasm32Isa w w
opener State (Wasm32St w) (Either Text Int)
-> (Either Text Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> (a -> StateT (Wasm32St w) Identity b)
-> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Text
err -> Text -> State (Wasm32St w) ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError Text
err
        Right Int
afterEnd -> Int -> State (Wasm32St w) ()
f Int
afterEnd

afterMatchingElseOrEnd ::
    (IsWord w) => Int -> Wasm32Isa w w -> (Int -> State (Wasm32St w) ()) -> State (Wasm32St w) ()
afterMatchingElseOrEnd :: forall w.
IsWord w =>
Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
afterMatchingElseOrEnd Int
pc Wasm32Isa w w
opener Int -> State (Wasm32St w) ()
f =
    Bool
-> Int -> Wasm32Isa w w -> State (Wasm32St w) (Either Text Int)
forall w.
IsWord w =>
Bool
-> Int -> Wasm32Isa w w -> State (Wasm32St w) (Either Text Int)
matchElseOrEnd Bool
True Int
pc Wasm32Isa w w
opener State (Wasm32St w) (Either Text Int)
-> (Either Text Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> (a -> StateT (Wasm32St w) Identity b)
-> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Text
err -> Text -> State (Wasm32St w) ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError Text
err
        Right Int
afterEnd -> Int -> State (Wasm32St w) ()
f Int
afterEnd

matchElseOrEnd :: (IsWord w) => Bool -> Int -> Wasm32Isa w w -> State (Wasm32St w) (Either Text Int)
matchElseOrEnd :: forall w.
IsWord w =>
Bool
-> Int -> Wasm32Isa w w -> State (Wasm32St w) (Either Text Int)
matchElseOrEnd Bool
stopAtElse Int
addr Wasm32Isa w w
opener = Int
-> State (Wasm32St w) (Either Text Int)
-> State (Wasm32St w) (Either Text Int)
forall w.
Int
-> State (Wasm32St w) (Either Text Int)
-> State (Wasm32St w) (Either Text Int)
cachedScan Int
addr (State (Wasm32St w) (Either Text Int)
 -> State (Wasm32St w) (Either Text Int))
-> State (Wasm32St w) (Either Text Int)
-> State (Wasm32St w) (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> State (Wasm32St w) (Either Text Int)
go (Int
0 :: Int) (Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Wasm32Isa w w -> Int
forall t. ByteSize t => t -> Int
byteSize Wasm32Isa w w
opener)
    where
        go :: Int -> Int -> State (Wasm32St w) (Either Text Int)
go Int
depth Int
at =
            Int -> State (Wasm32St w) (Either Text (Wasm32Isa w w))
forall w.
IsWord w =>
Int -> State (Wasm32St w) (Either Text (Wasm32Isa w w))
fetchInstructionAt Int
at State (Wasm32St w) (Either Text (Wasm32Isa w w))
-> (Either Text (Wasm32Isa w w)
    -> State (Wasm32St w) (Either Text Int))
-> State (Wasm32St w) (Either Text Int)
forall a b.
StateT (Wasm32St w) Identity a
-> (a -> StateT (Wasm32St w) Identity b)
-> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Left Text
err ->
                    Either Text Int -> State (Wasm32St w) (Either Text Int)
forall a. a -> StateT (Wasm32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> State (Wasm32St w) (Either Text Int))
-> Either Text Int -> State (Wasm32St w) (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left [i|scope at #{hexAddr 2 addr} has no matching end: #{err}|]
                Right Wasm32Isa w w
instruction ->
                    let next :: Int
next = Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Wasm32Isa w w -> Int
forall t. ByteSize t => t -> Int
byteSize Wasm32Isa w w
instruction
                     in case Wasm32Isa w w
instruction of
                            Wasm32Isa w w
Block -> Int -> Int -> State (Wasm32St w) (Either Text Int)
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
next
                            Wasm32Isa w w
Loop -> Int -> Int -> State (Wasm32St w) (Either Text Int)
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
next
                            Wasm32Isa w w
If -> Int -> Int -> State (Wasm32St w) (Either Text Int)
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
next
                            Wasm32Isa w w
Else | Bool
stopAtElse Bool -> Bool -> Bool
&& Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Either Text Int -> State (Wasm32St w) (Either Text Int)
forall a. a -> StateT (Wasm32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> State (Wasm32St w) (Either Text Int))
-> Either Text Int -> State (Wasm32St w) (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either Text Int
forall a b. b -> Either a b
Right Int
next
                            Wasm32Isa w w
End
                                | Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Either Text Int -> State (Wasm32St w) (Either Text Int)
forall a. a -> StateT (Wasm32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> State (Wasm32St w) (Either Text Int))
-> Either Text Int -> State (Wasm32St w) (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either Text Int
forall a b. b -> Either a b
Right Int
next
                                | Bool
otherwise -> Int -> Int -> State (Wasm32St w) (Either Text Int)
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
next
                            Wasm32Isa w w
_ -> Int -> Int -> State (Wasm32St w) (Either Text Int)
go Int
depth Int
next

returnFromCall :: forall w. (IsWord w) => State (Wasm32St w) ()
returnFromCall :: forall w. IsWord w => State (Wasm32St w) ()
returnFromCall =
    State (Wasm32St w) (Either Text (Int, Scope))
forall w. IsWord w => State (Wasm32St w) (Either Text (Int, Scope))
innermostCall State (Wasm32St w) (Either Text (Int, Scope))
-> (Either Text (Int, Scope) -> StateT (Wasm32St w) Identity ())
-> StateT (Wasm32St w) Identity ()
forall a b.
StateT (Wasm32St w) Identity a
-> (a -> StateT (Wasm32St w) Identity b)
-> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Text
err -> Text -> StateT (Wasm32St w) Identity ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError Text
err
        Right (Int
addr, CallScope{Int
csCallerFrameBase :: Int
csCallerFrameBase :: Scope -> Int
csCallerFrameBase, Int
csCallerLocalCount :: Int
csCallerLocalCount :: Scope -> Int
csCallerLocalCount, Int
csReturnPc :: Int
csReturnPc :: Scope -> Int
csReturnPc, Int
csResultCount :: Int
csResultCount :: Scope -> Int
csResultCount}) -> do
            results <- [w] -> [w]
forall a. [a] -> [a]
reverse ([w] -> [w])
-> StateT (Wasm32St w) Identity [w]
-> StateT (Wasm32St w) Identity [w]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> StateT (Wasm32St w) Identity w
-> StateT (Wasm32St w) Identity [w]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
csResultCount StateT (Wasm32St w) Identity w
forall w. IsWord w => State (Wasm32St w) w
popValue
            Wasm32St{frameBase} <- get
            modify $ \Wasm32St w
st ->
                Wasm32St w
st
                    { sp = frameBase + byteSizeT @w
                    , ctrlSp = addr
                    , frameBase = csCallerFrameBase
                    , localCount = csCallerLocalCount
                    }
            mapM_ pushValue results
            setPc csReturnPc
        Right (Int
addr, Scope
other) ->
            Text -> StateT (Wasm32St w) Identity ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError [i|control stack corrupted at #{hexAddr 2 addr}: expected a call record, found #{other}|]

branchTo :: forall w. (IsWord w) => Int -> Int -> State (Wasm32St w) ()
branchTo :: forall w. IsWord w => Int -> Int -> State (Wasm32St w) ()
branchTo Int
from Int
depth = do
    Wasm32St{ctrlSp, stackRoot} <- StateT (Wasm32St w) Identity (Wasm32St w)
forall s (m :: * -> *). MonadState s m => m s
get
    let record = Int
ctrlSp Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall w. IsWord w => Int
scopeRecordBytes @w
    cached <- if record >= stackRoot then cachedBranch from record else return Nothing
    case cached of
        Just BranchEntry{Int
beTo :: Int
beTo :: forall w. BranchEntry w -> Int
beTo, Int
beCtrlSp :: Int
beCtrlSp :: forall w. BranchEntry w -> Int
beCtrlSp} -> Int -> Int -> StateT (Wasm32St w) Identity ()
forall {w}. Int -> Int -> StateT (Wasm32St w) Identity ()
jump Int
beTo Int
beCtrlSp
        Maybe (BranchEntry w)
Nothing ->
            Int -> State (Wasm32St w) (Maybe (Int, [w]))
forall w. IsWord w => Int -> State (Wasm32St w) (Maybe (Int, [w]))
scopeRecordAtDepth Int
depth State (Wasm32St w) (Maybe (Int, [w]))
-> (Maybe (Int, [w]) -> StateT (Wasm32St w) Identity ())
-> StateT (Wasm32St w) Identity ()
forall a b.
StateT (Wasm32St w) Identity a
-> (a -> StateT (Wasm32St w) Identity b)
-> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe (Int, [w])
Nothing -> Text -> StateT (Wasm32St w) Identity ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError Text
"br/br_if: the scope it names went missing"
                Just (Int
addr, [w]
words_) -> case [w] -> Either Text Scope
forall a w. (BitPack a, IsWord w) => [w] -> Either Text a
unpackWords [w]
words_ of
                    Left Text
err -> Text -> StateT (Wasm32St w) Identity ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError (Text -> StateT (Wasm32St w) Identity ())
-> Text -> StateT (Wasm32St w) Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
ctrlCorruptedErr Int
addr Text
err
                    Right LoopScope{Int
csStart :: Int
csStart :: Scope -> Int
csStart} -> Int -> [w] -> Int -> Int -> StateT (Wasm32St w) Identity ()
taken Int
addr [w]
words_ Int
csStart (Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ forall w. IsWord w => Int
scopeRecordBytes @w)
                    Right BlockScope{Int
csEnd :: Int
csEnd :: Scope -> Int
csEnd} -> Int -> [w] -> Int -> Int -> StateT (Wasm32St w) Identity ()
taken Int
addr [w]
words_ (Int
csEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Wasm32Isa (ZonkAny 0) (ZonkAny 1) -> Int
forall t. ByteSize t => t -> Int
byteSize Wasm32Isa (ZonkAny 0) (ZonkAny 1)
forall w l. Wasm32Isa w l
End) Int
addr
                    Right CallScope{} ->
                        Text -> StateT (Wasm32St w) Identity ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError Text
"br/br_if: depth reaches past the enclosing function; use return to leave it"
    where
        jump :: Int -> Int -> StateT (Wasm32St w) Identity ()
jump Int
to Int
ctrlSp' = (Wasm32St w -> Wasm32St w) -> StateT (Wasm32St w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Wasm32St w
st -> Wasm32St w
st{ctrlSp = ctrlSp'}) StateT (Wasm32St w) Identity ()
-> StateT (Wasm32St w) Identity ()
-> StateT (Wasm32St w) Identity ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> StateT (Wasm32St w) Identity ()
forall w. Int -> State (Wasm32St w) ()
setPc Int
to
        taken :: Int -> [w] -> Int -> Int -> StateT (Wasm32St w) Identity ()
taken Int
addr [w]
words_ Int
to Int
ctrlSp' = do
            BranchEntry w -> StateT (Wasm32St w) Identity ()
forall w. IsWord w => BranchEntry w -> State (Wasm32St w) ()
rememberBranch BranchEntry{beFrom :: Int
beFrom = Int
from, beRecord :: Int
beRecord = Int
addr, beWords :: [w]
beWords = [w]
words_, beTo :: Int
beTo = Int
to, beCtrlSp :: Int
beCtrlSp = Int
ctrlSp'}
            Int -> Int -> StateT (Wasm32St w) Identity ()
forall {w}. Int -> Int -> StateT (Wasm32St w) Identity ()
jump Int
to Int
ctrlSp'

instance (IsWord w) => Machine (Wasm32St w) (Wasm32Isa w w) w where
    instructionFetch :: State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
instructionFetch = do
        st <- StateT (Wasm32St w) Identity (Wasm32St w)
forall s (m :: * -> *). MonadState s m => m s
get
        case st of
            Wasm32St{stopped :: forall w. Wasm32St w -> Bool
stopped = Bool
True} -> Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a. a -> StateT (Wasm32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Wasm32Isa w w)
 -> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w)))
-> Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, Wasm32Isa w w)
forall a b. a -> Either a b
Left Text
halted
            Wasm32St{internalError :: forall w. Wasm32St w -> Maybe Text
internalError = Just Text
err} -> Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a. a -> StateT (Wasm32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Wasm32Isa w w)
 -> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w)))
-> Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, Wasm32Isa w w)
forall a b. a -> Either a b
Left Text
err
            Wasm32St{Int
pc :: forall w. Wasm32St w -> Int
pc :: Int
pc} ->
                Int -> State (Wasm32St w) (Either Text (Wasm32Isa w w))
forall w.
IsWord w =>
Int -> State (Wasm32St w) (Either Text (Wasm32Isa w w))
fetchInstructionAt Int
pc
                    State (Wasm32St w) (Either Text (Wasm32Isa w w))
-> (Either Text (Wasm32Isa w w)
    -> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w)))
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a b.
StateT (Wasm32St w) Identity a
-> (a -> StateT (Wasm32St w) Identity b)
-> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \case
                            Left Text
err -> Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a. a -> StateT (Wasm32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Wasm32Isa w w)
 -> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w)))
-> Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, Wasm32Isa w w)
forall a b. a -> Either a b
Left Text
err
                            Right Wasm32Isa w w
instruction -> do
                                Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a. a -> StateT (Wasm32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Wasm32Isa w w)
 -> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w)))
-> Either Text (Int, Wasm32Isa w w)
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall a b. (a -> b) -> a -> b
$ (Int, Wasm32Isa w w) -> Either Text (Int, Wasm32Isa w w)
forall a b. b -> Either a b
Right (Int
pc, Wasm32Isa w w
instruction)
                        )

    instructionStep :: State (Wasm32St w) ()
instructionStep = do
        (pc, instruction) <- (Text -> (Int, Wasm32Isa w w))
-> ((Int, Wasm32Isa w w) -> (Int, Wasm32Isa w w))
-> Either Text (Int, Wasm32Isa w w)
-> (Int, Wasm32Isa w w)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
err -> Text -> (Int, Wasm32Isa w w)
forall a t. (HasCallStack, IsText t) => t -> a
error [i|internal error: #{err}|]) (Int, Wasm32Isa w w) -> (Int, Wasm32Isa w w)
forall a. a -> a
id (Either Text (Int, Wasm32Isa w w) -> (Int, Wasm32Isa w w))
-> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
-> StateT (Wasm32St w) Identity (Int, Wasm32Isa w w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State (Wasm32St w) (Either Text (Int, Wasm32Isa w w))
forall st isa w.
Machine st isa w =>
State st (Either Text (Int, isa))
instructionFetch
        instructionExecute pc instruction

    instructionExecute :: Int -> Wasm32Isa w w -> State (Wasm32St w) ()
instructionExecute Int
pc Wasm32Isa w w
instruction =
        case Wasm32Isa w w
instruction of
            I32Const w
value -> w -> State (Wasm32St w) ()
forall w. IsWord w => w -> State (Wasm32St w) ()
pushValue w
value State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32Add -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary w -> w -> w
forall a. Num a => a -> a -> a
(+) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32Sub -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary (-) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32Mul -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary w -> w -> w
forall a. Num a => a -> a -> a
(*) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32DivS -> State (Wasm32St w) ()
signedDiv State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32RemS -> State (Wasm32St w) ()
signedRem State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32And -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary w -> w -> w
forall a. Bits a => a -> a -> a
(.&.) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32Or -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary w -> w -> w
forall a. Bits a => a -> a -> a
(.|.) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32Xor -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary w -> w -> w
forall a. Bits a => a -> a -> a
xor State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32Shl -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary (\w
x w
y -> w
x w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftL` (w -> Int
forall a. Enum a => a -> Int
fromEnum w
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1F)) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32ShrS -> (w -> w -> w) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary (\w
x w
y -> w
x w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` (w -> Int
forall a. Enum a => a -> Int
fromEnum w
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1F)) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32ShrU -> (Unsign w -> Unsign w -> w) -> State (Wasm32St w) ()
forall {a}.
(FromSign a, FiniteBits a, ByteSize a, Default a, Hashable a,
 Read a, WordParts a, Bounded a, Integral a, Show a) =>
(Unsign a -> Unsign a -> a) -> StateT (Wasm32St a) Identity ()
unsignedBinary (\Unsign w
x Unsign w
y -> Unsign w -> w
forall w. FromSign w => Unsign w -> w
toSign (Unsign w -> w) -> Unsign w -> w
forall a b. (a -> b) -> a -> b
$ Unsign w
x Unsign w -> Int -> Unsign w
forall a. Bits a => a -> Int -> a
`shiftR` (Unsign w -> Int
forall a. Enum a => a -> Int
fromEnum Unsign w
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1F)) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32Eqz -> do
                value <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                pushValue $ if value == 0 then 1 else 0
                nextPc instruction
            Wasm32Isa w w
I32Eq -> (w -> w -> Bool) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> Bool) -> StateT (Wasm32St t) Identity ()
compareS w -> w -> Bool
forall a. Eq a => a -> a -> Bool
(==) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32LtS -> (w -> w -> Bool) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> Bool) -> StateT (Wasm32St t) Identity ()
compareS w -> w -> Bool
forall a. Ord a => a -> a -> Bool
(<) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32LeS -> (w -> w -> Bool) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> Bool) -> StateT (Wasm32St t) Identity ()
compareS w -> w -> Bool
forall a. Ord a => a -> a -> Bool
(<=) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32GtS -> (w -> w -> Bool) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> Bool) -> StateT (Wasm32St t) Identity ()
compareS w -> w -> Bool
forall a. Ord a => a -> a -> Bool
(>) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32GeS -> (w -> w -> Bool) -> State (Wasm32St w) ()
forall {t}.
(FiniteBits t, ByteSize t, Default t, Hashable t, Read t,
 WordParts t, FromSign t, Bounded t, Integral t, Show t) =>
(t -> t -> Bool) -> StateT (Wasm32St t) Identity ()
compareS w -> w -> Bool
forall a. Ord a => a -> a -> Bool
(>=) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32LtU -> (Unsign w -> Unsign w -> Bool) -> State (Wasm32St w) ()
forall {a}.
(FromSign a, FiniteBits a, ByteSize a, Default a, Hashable a,
 Read a, WordParts a, Bounded a, Integral a, Show a) =>
(Unsign a -> Unsign a -> Bool) -> StateT (Wasm32St a) Identity ()
compareU Unsign w -> Unsign w -> Bool
forall a. Ord a => a -> a -> Bool
(<) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32LeU -> (Unsign w -> Unsign w -> Bool) -> State (Wasm32St w) ()
forall {a}.
(FromSign a, FiniteBits a, ByteSize a, Default a, Hashable a,
 Read a, WordParts a, Bounded a, Integral a, Show a) =>
(Unsign a -> Unsign a -> Bool) -> StateT (Wasm32St a) Identity ()
compareU Unsign w -> Unsign w -> Bool
forall a. Ord a => a -> a -> Bool
(<=) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32GtU -> (Unsign w -> Unsign w -> Bool) -> State (Wasm32St w) ()
forall {a}.
(FromSign a, FiniteBits a, ByteSize a, Default a, Hashable a,
 Read a, WordParts a, Bounded a, Integral a, Show a) =>
(Unsign a -> Unsign a -> Bool) -> StateT (Wasm32St a) Identity ()
compareU Unsign w -> Unsign w -> Bool
forall a. Ord a => a -> a -> Bool
(>) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
I32GeU -> (Unsign w -> Unsign w -> Bool) -> State (Wasm32St w) ()
forall {a}.
(FromSign a, FiniteBits a, ByteSize a, Default a, Hashable a,
 Read a, WordParts a, Bounded a, Integral a, Show a) =>
(Unsign a -> Unsign a -> Bool) -> StateT (Wasm32St a) Identity ()
compareU Unsign w -> Unsign w -> Bool
forall a. Ord a => a -> a -> Bool
(>=) State (Wasm32St w) ()
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            I32Load w
offset -> Int -> (Int -> State (Wasm32St w) w) -> State (Wasm32St w) ()
load (w -> Int
forall a. Enum a => a -> Int
fromEnum w
offset) Int -> State (Wasm32St w) w
forall w. IsWord w => Int -> State (Wasm32St w) w
getWord
            I32Load8U w
offset -> Int -> (Int -> State (Wasm32St w) w) -> State (Wasm32St w) ()
load (w -> Int
forall a. Enum a => a -> Int
fromEnum w
offset) ((Word8 -> w)
-> StateT (Wasm32St w) Identity Word8 -> State (Wasm32St w) w
forall a b.
(a -> b)
-> StateT (Wasm32St w) Identity a -> StateT (Wasm32St w) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StateT (Wasm32St w) Identity Word8 -> State (Wasm32St w) w)
-> (Int -> StateT (Wasm32St w) Identity Word8)
-> Int
-> State (Wasm32St w) w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StateT (Wasm32St w) Identity Word8
forall w. IsWord w => Int -> State (Wasm32St w) Word8
getByte)
            I32Load8S w
offset -> Int -> (Int -> State (Wasm32St w) w) -> State (Wasm32St w) ()
load (w -> Int
forall a. Enum a => a -> Int
fromEnum w
offset) ((Word8 -> w)
-> StateT (Wasm32St w) Identity Word8 -> State (Wasm32St w) w
forall a b.
(a -> b)
-> StateT (Wasm32St w) Identity a -> StateT (Wasm32St w) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> w) -> (Word8 -> Int8) -> Word8 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Int8)) (StateT (Wasm32St w) Identity Word8 -> State (Wasm32St w) w)
-> (Int -> StateT (Wasm32St w) Identity Word8)
-> Int
-> State (Wasm32St w) w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StateT (Wasm32St w) Identity Word8
forall w. IsWord w => Int -> State (Wasm32St w) Word8
getByte)
            I32Store w
offset -> Int -> (Int -> w -> State (Wasm32St w) ()) -> State (Wasm32St w) ()
store (w -> Int
forall a. Enum a => a -> Int
fromEnum w
offset) Int -> w -> State (Wasm32St w) ()
forall w. IsWord w => Int -> w -> State (Wasm32St w) ()
setWord
            I32Store8 w
offset -> Int -> (Int -> w -> State (Wasm32St w) ()) -> State (Wasm32St w) ()
store (w -> Int
forall a. Enum a => a -> Int
fromEnum w
offset) (\Int
addr -> Int -> Word8 -> State (Wasm32St w) ()
forall w. IsWord w => Int -> Word8 -> State (Wasm32St w) ()
setByte Int
addr (Word8 -> State (Wasm32St w) ())
-> (w -> Word8) -> w -> State (Wasm32St w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            Wasm32Isa w w
If -> do
                condition <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                if condition == 0
                    then afterMatchingElseOrEnd pc instruction setPc
                    else nextPc instruction
            Wasm32Isa w w
Else -> Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
forall w.
IsWord w =>
Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
afterMatchingEnd Int
pc Wasm32Isa w w
instruction Int -> State (Wasm32St w) ()
forall w. Int -> State (Wasm32St w) ()
setPc
            Wasm32Isa w w
End ->
                Int -> State (Wasm32St w) (Maybe (Either Text Scope))
forall w.
IsWord w =>
Int -> State (Wasm32St w) (Maybe (Either Text Scope))
scopeAtDepth Int
0 State (Wasm32St w) (Maybe (Either Text Scope))
-> (Maybe (Either Text Scope) -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> (a -> StateT (Wasm32St w) Identity b)
-> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe (Either Text Scope)
Nothing -> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
                    Just (Left Text
err) -> Text -> State (Wasm32St w) ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError Text
err
                    Just (Right BlockScope{Int
csEnd :: Scope -> Int
csEnd :: Int
csEnd})
                        | Int
csEnd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pc -> do
                            Int -> State (Wasm32St w) ()
forall w. IsWord w => Int -> State (Wasm32St w) ()
retireScopes Int
1
                            Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
                    Just (Right LoopScope{Int
csEnd :: Scope -> Int
csEnd :: Int
csEnd})
                        | Int
csEnd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pc -> do
                            Int -> State (Wasm32St w) ()
forall w. IsWord w => Int -> State (Wasm32St w) ()
retireScopes Int
1
                            Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
                    Maybe (Either Text Scope)
_ -> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
Loop ->
                Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
forall w.
IsWord w =>
Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
afterMatchingEnd Int
pc Wasm32Isa w w
instruction ((Int -> State (Wasm32St w) ()) -> State (Wasm32St w) ())
-> (Int -> State (Wasm32St w) ()) -> State (Wasm32St w) ()
forall a b. (a -> b) -> a -> b
$ \Int
afterEnd -> do
                    Scope -> State (Wasm32St w) ()
forall w. IsWord w => Scope -> State (Wasm32St w) ()
pushScope LoopScope{csStart :: Int
csStart = Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Wasm32Isa w w -> Int
forall t. ByteSize t => t -> Int
byteSize Wasm32Isa w w
instruction, csEnd :: Int
csEnd = Int
afterEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Wasm32Isa (ZonkAny 2) (ZonkAny 3) -> Int
forall t. ByteSize t => t -> Int
byteSize Wasm32Isa (ZonkAny 2) (ZonkAny 3)
forall w l. Wasm32Isa w l
End}
                    Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
Block ->
                Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
forall w.
IsWord w =>
Int
-> Wasm32Isa w w
-> (Int -> State (Wasm32St w) ())
-> State (Wasm32St w) ()
afterMatchingEnd Int
pc Wasm32Isa w w
instruction ((Int -> State (Wasm32St w) ()) -> State (Wasm32St w) ())
-> (Int -> State (Wasm32St w) ()) -> State (Wasm32St w) ()
forall a b. (a -> b) -> a -> b
$ \Int
afterEnd -> do
                    Scope -> State (Wasm32St w) ()
forall w. IsWord w => Scope -> State (Wasm32St w) ()
pushScope BlockScope{csEnd :: Int
csEnd = Int
afterEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Wasm32Isa (ZonkAny 4) (ZonkAny 5) -> Int
forall t. ByteSize t => t -> Int
byteSize Wasm32Isa (ZonkAny 4) (ZonkAny 5)
forall w l. Wasm32Isa w l
End}
                    Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Br w
depth -> Int -> Int -> State (Wasm32St w) ()
forall w. IsWord w => Int -> Int -> State (Wasm32St w) ()
branchTo Int
pc (w -> Int
forall a. Enum a => a -> Int
fromEnum w
depth)
            BrIf w
depth -> do
                condition <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                if condition == 0
                    then nextPc instruction
                    else branchTo pc (fromEnum depth)
            Wasm32Isa w w
Drop -> State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue State (Wasm32St w) w
-> State (Wasm32St w) () -> State (Wasm32St w) ()
forall a b.
StateT (Wasm32St w) Identity a
-> StateT (Wasm32St w) Identity b -> StateT (Wasm32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Wasm32Isa w w
Select -> do
                condition <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                onFalse <- popValue
                onTrue <- popValue
                pushValue (if condition /= 0 then onTrue else onFalse)
                nextPc instruction
            Wasm32Isa w w
Unreachable -> Text -> State (Wasm32St w) ()
forall w. Text -> State (Wasm32St w) ()
raiseInternalError Text
"unreachable"
            LocalGet w
idx -> do
                addr <- Int -> State (Wasm32St w) Int
forall w. IsWord w => Int -> State (Wasm32St w) Int
localAddr (w -> Int
forall a. Enum a => a -> Int
fromEnum w
idx)
                value <- getWord addr
                pushValue value
                nextPc instruction
            LocalSet w
idx -> do
                addr <- Int -> State (Wasm32St w) Int
forall w. IsWord w => Int -> State (Wasm32St w) Int
localAddr (w -> Int
forall a. Enum a => a -> Int
fromEnum w
idx)
                value <- popValue
                setWord addr value
                nextPc instruction
            LocalTee w
idx -> do
                addr <- Int -> State (Wasm32St w) Int
forall w. IsWord w => Int -> State (Wasm32St w) Int
localAddr (w -> Int
forall a. Enum a => a -> Int
fromEnum w
idx)
                value <- popValue
                setWord addr value
                pushValue value
                nextPc instruction
            LocalsReserve w
n -> do
                Int -> State (Wasm32St w) ()
forall w. IsWord w => Int -> State (Wasm32St w) ()
reserveLocals (w -> Int
forall a. Enum a => a -> Int
fromEnum w
n)
                Wasm32Isa w w -> State (Wasm32St w) ()
forall w. Wasm32Isa w w -> State (Wasm32St w) ()
nextPc Wasm32Isa w w
instruction
            Call{w
callParamCount :: w
callParamCount :: forall w l. Wasm32Isa w l -> l
callParamCount, w
callResultCount :: w
callResultCount :: forall w l. Wasm32Isa w l -> l
callResultCount} -> do
                callTarget <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                Wasm32St{sp, frameBase, localCount} <- get
                let paramCount = w -> Int
forall a. Enum a => a -> Int
fromEnum w
callParamCount
                    calleeFrameBase = Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
paramCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall t. ByteSizeT t => Int
byteSizeT @w
                pushScope
                    CallScope
                        { csCallerFrameBase = frameBase
                        , csCallerLocalCount = localCount
                        , csReturnPc = pc + byteSize instruction
                        , csResultCount = fromEnum callResultCount
                        }
                modify $ \Wasm32St w
st ->
                    Wasm32St w
st
                        { frameBase = calleeFrameBase
                        , localCount = paramCount
                        }
                setPc (fromEnum callTarget)
            Wasm32Isa w w
Return -> State (Wasm32St w) ()
forall w. IsWord w => State (Wasm32St w) ()
returnFromCall
            Wasm32Isa w w
SpInit -> do
                addr <- w -> Int
forall a. Enum a => a -> Int
fromEnum (w -> Int) -> State (Wasm32St w) w -> State (Wasm32St w) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                modify $ \Wasm32St w
st ->
                    Wasm32St w
st
                        { sp = addr
                        , stackRoot = addr
                        , ctrlSp = addr
                        , frameBase = addr - byteSizeT @w
                        , localCount = 0
                        }
                nextPc instruction
            Wasm32Isa w w
Halt -> (Wasm32St w -> Wasm32St w) -> State (Wasm32St w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Wasm32St w -> Wasm32St w) -> State (Wasm32St w) ())
-> (Wasm32St w -> Wasm32St w) -> State (Wasm32St w) ()
forall a b. (a -> b) -> a -> b
$ \Wasm32St w
st -> Wasm32St w
st{stopped = True}
        where
            load :: Int -> (Int -> State (Wasm32St w) w) -> State (Wasm32St w) ()
load Int
offset Int -> State (Wasm32St w) w
readAt = do
                addr <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                readAt (fromEnum addr + offset) >>= pushValue
                nextPc instruction
            store :: Int -> (Int -> w -> State (Wasm32St w) ()) -> State (Wasm32St w) ()
store Int
offset Int -> w -> State (Wasm32St w) ()
writeAt = do
                value <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                addr <- popValue
                writeAt (fromEnum addr + offset) value
                nextPc instruction
            binary :: (t -> t -> t) -> StateT (Wasm32St t) Identity ()
binary t -> t -> t
op = do
                y <- State (Wasm32St t) t
forall w. IsWord w => State (Wasm32St w) w
popValue
                x <- popValue
                pushValue (x `op` y)
            unsignedBinary :: (Unsign a -> Unsign a -> a) -> StateT (Wasm32St a) Identity ()
unsignedBinary Unsign a -> Unsign a -> a
op = do
                y <- a -> Unsign a
forall w. FromSign w => w -> Unsign w
fromSign (a -> Unsign a)
-> StateT (Wasm32St a) Identity a
-> StateT (Wasm32St a) Identity (Unsign a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Wasm32St a) Identity a
forall w. IsWord w => State (Wasm32St w) w
popValue
                x <- fromSign <$> popValue
                pushValue (op x y)
            signedDiv :: State (Wasm32St w) ()
signedDiv = do
                y <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                x <- popValue
                if
                    | y == 0 -> raiseInternalError "integer divide by zero"
                    | x == minBound && y == -1 -> raiseInternalError "integer overflow"
                    | otherwise -> pushValue (x `quot` y)
            signedRem :: State (Wasm32St w) ()
signedRem = do
                y <- State (Wasm32St w) w
forall w. IsWord w => State (Wasm32St w) w
popValue
                x <- popValue
                if y == 0
                    then raiseInternalError "integer divide by zero"
                    else pushValue (x `rem` y)
            compareS :: (t -> t -> Bool) -> StateT (Wasm32St t) Identity ()
compareS t -> t -> Bool
op = do
                y <- State (Wasm32St t) t
forall w. IsWord w => State (Wasm32St w) w
popValue
                x <- popValue
                pushValue $ if x `op` y then 1 else 0
            compareU :: (Unsign a -> Unsign a -> Bool) -> StateT (Wasm32St a) Identity ()
compareU Unsign a -> Unsign a -> Bool
op = do
                y <- a -> Unsign a
forall w. FromSign w => w -> Unsign w
fromSign (a -> Unsign a)
-> StateT (Wasm32St a) Identity a
-> StateT (Wasm32St a) Identity (Unsign a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Wasm32St a) Identity a
forall w. IsWord w => State (Wasm32St w) w
popValue
                x <- fromSign <$> popValue
                pushValue $ if x `op` y then 1 else 0