Enable 'in' instruction handler

This commit is contained in:
2021-11-12 15:42:50 +01:00
parent e3bcebcece
commit 41438cc709
2 changed files with 38 additions and 11 deletions

View File

@@ -30,6 +30,7 @@ List of available instructions:
| ``0x18`` | ``CLR x`` | Wipe out ``x`` values before the top value from the stack | | ``0x18`` | ``CLR x`` | Wipe out ``x`` values before the top value from the stack |
## Example ## Example
### Example 1
The `2*3+5` formula written as the MVM assembly code: The `2*3+5` formula written as the MVM assembly code:
```asm ```asm
main: push 2 main: push 2
@@ -41,15 +42,15 @@ main: push 2
clr 2 clr 2
halt halt
sum: ld 0 sum: ld 0
ld 1 ld 1
add add
ret ret
prd: ld 0 prd: ld 0
ld 1 ld 1
mul mul
ret ret
``` ```
The result of execution with the `debug = True` flag: The result of execution with the `debug = True` flag:
``` ```
@@ -90,4 +91,23 @@ VM {_pc = 14, _fp = -1, _stack = fromList [11], _halt = False, _debug = True}
Done: Done:
VM {_pc = 14, _fp = -1, _stack = fromList [11], _halt = True, _debug = True} VM {_pc = 14, _fp = -1, _stack = fromList [11], _halt = True, _debug = True}
```
### Example 2
The base I/O example - simple echo:
```asm
read: in
dup
out
push 0x0A
sub
jne &read ; loop until the input != new line (0x0A)
halt
```
The execution for the input string `Hello, world!`:
```
Hello, world!
Done:
VM {_pc = 8, _fp = -1, _stack = fromList [], _halt = True, _debug = False}
``` ```

View File

@@ -1,7 +1,8 @@
module VirtualMachine.Instruction where module VirtualMachine.Instruction where
import Data.Char (chr) import Data.Char (chr, ord)
import Data.Word (Word8) import Data.Word (Word8)
import System.IO (stdin, hGetChar)
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import Control.Monad.Trans (lift, liftIO) import Control.Monad.Trans (lift, liftIO)
import Control.Monad.Trans.Except (ExceptT, except) import Control.Monad.Trans.Except (ExceptT, except)
@@ -49,7 +50,7 @@ instructions = [ Simple { _op = Nop, _noParams = 0, _noPops = 0, _sAction = (\
, Complex { _op = Jge, _noParams = 1, _noPops = 1, _cAction = jumpIf (>=) } , Complex { _op = Jge, _noParams = 1, _noPops = 1, _cAction = jumpIf (>=) }
, Complex { _op = Jle, _noParams = 1, _noPops = 1, _cAction = jumpIf (<=) } , Complex { _op = Jle, _noParams = 1, _noPops = 1, _cAction = jumpIf (<=) }
, Complex { _op = Ld, _noParams = 1, _noPops = 0, _cAction = load } , Complex { _op = Ld, _noParams = 1, _noPops = 0, _cAction = load }
, Complex { _op = In, _noParams = 0, _noPops = 0, _cAction = niy In } , Complex { _op = In, _noParams = 0, _noPops = 0, _cAction = input }
, Complex { _op = Out, _noParams = 0, _noPops = 1, _cAction = output } , Complex { _op = Out, _noParams = 0, _noPops = 1, _cAction = output }
, Complex { _op = Clr, _noParams = 1, _noPops = 0, _cAction = clear } , Complex { _op = Clr, _noParams = 1, _noPops = 0, _cAction = clear }
] ]
@@ -112,6 +113,13 @@ jumpIf p (addr:_) (top:_) = lift $ do
jumpIf _ [] _ = throwError "Address expected" jumpIf _ [] _ = throwError "Address expected"
jumpIf _ _ [] = throwError "Empty stack - nothing to compare" jumpIf _ _ [] = throwError "Empty stack - nothing to compare"
input :: Params -> Pops -> ExceptT String Machine ()
input _ _ = lift $ do
c <- liftIO $ hGetChar stdin
push [ord c]
forward 1
return()
output :: Params -> Pops -> ExceptT String Machine () output :: Params -> Pops -> ExceptT String Machine ()
output _ (char:_) = lift $ do output _ (char:_) = lift $ do
liftIO $ putStr $ [chr char] liftIO $ putStr $ [chr char]
@@ -119,7 +127,6 @@ output _ (char:_) = lift $ do
return () return ()
output _ [] = except $ Left $ "Empty stack - nothing to output" output _ [] = except $ Left $ "Empty stack - nothing to output"
load :: Params -> Pops -> ExceptT String Machine () load :: Params -> Pops -> ExceptT String Machine ()
load (index:_) _ = do load (index:_) _ = do
fp <- lift getFp fp <- lift getFp