bartek/mvm
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add support for 'ldl' and 'stl' instructions

Browse Source
This commit is contained in:
Bartłomiej Przemysław Pluta
2021-11-14 21:50:29 +01:00
parent 3bb880f045
commit e7c413e9eb
4 changed files with 216 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
README.md
View File

@@ -24,10 +24,14 @@ List of available instructions:
| ``0x12`` | ``JL x`` | Jump to ``x`` **if** top element ``< 0 `` |
| ``0x13`` | ``JGE x`` | Jump to ``x`` **if** top element ``>= 0`` |
| ``0x14`` | ``JLE x`` | Jump to ``x`` **if** top element ``<= 0`` |
| ``0x15`` | ``LD x`` | Push local variable to stack |
| ``0x15`` | ``LDA x`` | Push local variable to stack |
| ``0x16`` | ``IN`` | Read input from stdin |
| ``0x17`` | ``OUT`` | Put top stack value to stdout as char |
| ``0x18`` | ``CLR x`` | Wipe out ``x`` values before the top value from the stack |
| ``0x19`` | ``ROLL`` | Rotate the stack/stack frame |
| ``0x1A`` | ``OVER`` | Duplicate and push the second value from the top |
| ``0x1B`` | ``LDL x`` | Lift the ``x`` from the _fp_ variable to the top of the stack |
| ``0x1C`` | ``STL x`` | Store the top stack value under the ``x`` from the _fp_ variable |
## Example
### Example 1
@@ -42,13 +46,13 @@ main: push 2
clr 2
halt
sum: ld 0
ld 1
sum: lda 0
lda 1
add
ret
prd: ld 0
ld 1
prd: lda 0
lda 1
mul
ret
```
@@ -110,4 +114,76 @@ Hello, world!
Done:
VM {_pc = 8, _fp = -1, _stack = fromList [], _halt = True, _debug = False}
```
### Example 3
The power ($2^{10}$) computation - loop variant
```asm
push 2
push 10
call &pow
clr 2
halt
pow: lda 1 ; base
lda 0 ; exp
push 1 ; acc
; | Stack:
loop: ldl 1 ; if exp == 0 | exp
je &done ; then return | exp
pop ; |
; |
ldl 2 ; Evaluate | acc
ldl 0 ; next power | acc base
mul ; | acc*base
stl 2 ; |
; |
ldl 1 ; Decrement exp | exp
push 1 ; | exp 1
sub ; | exp-1
stl 1 ; |
jmp &loop ; |
done: ldl 2 ; | ... acc
ret ; | acc
```
The result of execution:
```
Done:
VM {_pc = 8, _fp = -1, _stack = fromList [1024], _halt = True, _debug = False}
```
### Example 4
The power ($2^{10}$) computation - recursive variant
```asm
push 2 ; base
push 10 ; exp
call &pow
clr 2
halt
pow: lda 1 ; base
lda 0 ; exp
ldl 1 ; push exp to top
je &edge ; the edge case: if exp == 0 then return 1
pop ; pop exp
; | Stack:
ldl 0 ; | base
ldl 1 ; | base exp
push 1 ; | base exp 1
sub ; | base exp-1
call &pow ; | base exp-1 base^(exp-1)]
clr 1 ; | base base^(exp-1)
mul ; | base*base^(exp-1)
ret ; | base*base^(exp-1)
edge: pop
push 1 ; return 1
ret
```
The result of execution:
```
Done:
VM {_pc = 8, _fp = -1, _stack = fromList [1024], _halt = True, _debug = False}
```

29
app/VirtualMachine/Instruction.hs
View File

@@ -3,13 +3,14 @@ module VirtualMachine.Instruction where
import Data.Char (chr, ord)
import Data.Word (Word8)
import System.IO (stdin, hGetChar)
import Control.Monad (unless)
import Control.Monad.Except (throwError)
import Control.Monad.Trans (lift, liftIO)
import Control.Monad.Trans.Except (ExceptT)
import qualified Data.Map as M
import qualified Data.Sequence as S
import VirtualMachine.VM (Op(..), Machine, push, pop, forward, getAt, getPc, getFp, getStackSize, setPc, setFp, setHalt)
import VirtualMachine.VM (Op(..), Machine, push, pop, forward, getAt, getPc, getFp, getStackSize, setAt, setPc, setFp, setHalt)
type Params = [Int]
@@ -55,6 +56,8 @@ instructions = [ Simple { _op = Nop, _noParams = 0, _noPops = 0, _sAction = (\
, Complex { _op = Out, _noParams = 0, _noPops = 1, _cAction = output }
, Complex { _op = Clr, _noParams = 1, _noPops = 0, _cAction = clear }
, Complex { _op = Roll, _noParams = 0, _noPops = 0, _cAction = roll }
, Complex { _op = Ldl, _noParams = 1, _noPops = 0, _cAction = loadLocal }
, Complex { _op = Stl, _noParams = 1, _noPops = 1, _cAction = storeLocal }
]
instructionByOp :: M.Map Op Instruction
@@ -167,4 +170,26 @@ roll _ _ = lift $ do
push $ xs ++ [x]
return ()
forward 1
return ()
return ()
loadLocal :: Params -> Pops -> ExceptT String Machine ()
loadLocal (index:_) _ = do
fp <- lift getFp
unless (fp > -1) (throwError "No active stack frame to load local variable")
stackSize <- lift getStackSize
val <- getAt (stackSize - fp - 3 - index) $ "No stack value on the active frame under the index: " ++ (show index)
lift $ push [val]
lift $ forward 2
return ()
loadLocal [] _ = throwError "Local variable index expected"
storeLocal :: Params -> Pops -> ExceptT String Machine ()
storeLocal (index:_) (val:_) = do
fp <- lift getFp
unless (fp > -1) (throwError "No active stack frame to store local variable")
stackSize <- lift getStackSize
lift $ setAt (stackSize - fp - 3 - index) val
lift $ forward 2
return ()
storeLocal [] _ = throwError "Local variable index expected"
storeLocal _ [] = throwError "Empty stack - nothing to store"

9
app/VirtualMachine/VM.hs
View File

@@ -43,6 +43,8 @@ data Op = Nop -- 0x00
| Clr -- 0x18
| Roll -- 0x19
| Over -- 0x1A
| Ldl -- 0x1B
| Stl -- 0x1C
deriving (Eq, Ord, Enum, Show, Read, Bounded)
type Machine = StateT VM IO
@@ -77,6 +79,13 @@ getAt index err = do
(Just i) -> return i
Nothing -> throwError err
setAt :: Int -> Int -> Machine ()
setAt index val = do
vm <- get
let stack = _stack vm
let stack' = S.update index val stack
put vm { _stack = stack' }
getStackSize :: Machine Int
getStackSize = get >>= (return . length . _stack)

99
test/VirtualMachineSpec.hs
View File

@@ -993,6 +993,52 @@ spec = do
actual <- run input
actual `shouldBe` expected
describe "ldl" $ do
it "lifts stack value to the top" $ do
let input = " call &fun \n\
\ fun: push 1 \n\
\ push 2 \n\
\ push 3 \n\
\ push 4 \n\
\ push 5 \n\
\ ldl 0 \n\
\ halt "
let expected = done [1, 5, 4, 3, 2, 1, 2, -1] 14 0
actual <- run input
actual `shouldBe` expected
it "raises error if not called in the function context (fp == -1)" $ do
let input = " push 1 \n\
\ push 2 \n\
\ push 3 \n\
\ ldl 0 \n\
\ halt "
let expected = Left "No active stack frame to load local variable"
actual <- run input
actual `shouldBe` expected
describe "ldl" $ do
it "updates local variable value" $ do
let input = " call &fun \n\
\ fun: push 1 \n\
\ push 2 \n\
\ push 3 \n\
\ push 4 \n\
\ push 5 \n\
\ stl 0 \n\
\ halt "
let expected = done [4, 3, 2, 5, 2, -1] 14 0
actual <- run input
actual `shouldBe` expected
it "raises error if not called in the function context (fp == -1)" $ do
let input = " push 1 \n\
\ push 2 \n\
\ push 3 \n\
\ stl 0 \n\
\ halt "
let expected = Left "No active stack frame to store local variable"
actual <- run input
actual `shouldBe` expected
describe "examples" $ do
it "example #1" $ do
let input = " main: push 2 \n\
@@ -1025,4 +1071,57 @@ spec = do
\ halt "
let expected = done [0] 7 (-1)
actual <- run input
actual `shouldBe` expected
it "example #3: power - loop variant" $ do
let input = " push 3 \n\
\ push 6 \n\
\ call &pow \n\
\ clr 2 \n\
\ halt \n\
\ pow: lda 1 \n\
\ lda 0 \n\
\ push 1 \n\
\ loop: ldl 1 \n\
\ je &done \n\
\ pop \n\
\ ldl 2 \n\
\ ldl 0 \n\
\ mul \n\
\ stl 2 \n\
\ ldl 1 \n\
\ push 1 \n\
\ sub \n\
\ stl 1 \n\
\ jmp &loop \n\
\ done: ldl 2 \n\
\ ret "
let expected = done [3 ^ (6 :: Int)] 8 (-1)
actual <- run input
actual `shouldBe` expected
it "example #4: power - recursive variant" $ do
let input = " push 4 \n\
\ push 7 \n\
\ call &pow \n\
\ clr 2 \n\
\ halt \n\
\ pow: lda 1 \n\
\ lda 0 \n\
\ ldl 1 \n\
\ je &edge \n\
\ pop \n\
\ ldl 0 \n\
\ ldl 1 \n\
\ push 1 \n\
\ sub \n\
\ call &pow \n\
\ clr 1 \n\
\ mul \n\
\ ret \n\
\ edge: pop \n\
\ push 1 \n\
\ ret "
let expected = done [4 ^ (7 :: Int)] 8 (-1)
actual <- run input
actual `shouldBe` expected