From e7c413e9eb5cd0bb2fcbd40d8ceefcc4c841ab32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bart=C5=82omiej=20Przemys=C5=82aw=20Pluta?= Date: Sun, 14 Nov 2021 21:50:29 +0100 Subject: [PATCH] Add support for 'ldl' and 'stl' instructions --- README.md | 86 +++++++++++++++++++++++++-- app/VirtualMachine/Instruction.hs | 29 ++++++++- app/VirtualMachine/VM.hs | 9 +++ test/VirtualMachineSpec.hs | 99 +++++++++++++++++++++++++++++++ 4 files changed, 216 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index a479117..72a7352 100644 --- a/README.md +++ b/README.md @@ -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} ``` \ No newline at end of file diff --git a/app/VirtualMachine/Instruction.hs b/app/VirtualMachine/Instruction.hs index c43c9f6..5c56b8d 100644 --- a/app/VirtualMachine/Instruction.hs +++ b/app/VirtualMachine/Instruction.hs @@ -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 () \ No newline at end of file + 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" \ No newline at end of file diff --git a/app/VirtualMachine/VM.hs b/app/VirtualMachine/VM.hs index a97139d..5db5bda 100644 --- a/app/VirtualMachine/VM.hs +++ b/app/VirtualMachine/VM.hs @@ -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) diff --git a/test/VirtualMachineSpec.hs b/test/VirtualMachineSpec.hs index 73c0e3c..f7ad12c 100644 --- a/test/VirtualMachineSpec.hs +++ b/test/VirtualMachineSpec.hs @@ -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 \ No newline at end of file