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

Disable stack modification by branching (j*) instructions

Browse Source
This commit is contained in:
Bartłomiej Przemysław Pluta
2021-11-14 11:06:56 +01:00
parent 434d5a16ff
commit 6c50259228
3 changed files with 51 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
app/VirtualMachine/Instruction.hs
View File

@@ -110,6 +110,7 @@ jump [] _ = throwError "Address expected"
jumpIf :: (Int -> Int -> Bool) -> Params -> Pops -> ExceptT String Machine () jumpIf :: (Int -> Int -> Bool) -> Params -> Pops -> ExceptT String Machine ()
jumpIf p (addr:_) (top:_) = lift $ do jumpIf p (addr:_) (top:_) = lift $ do
pc <- getPc pc <- getPc
push [top]
setPc $ if top `p` 0 then addr else pc + 2 setPc $ if top `p` 0 then addr else pc + 2
return () return ()
jumpIf _ [] _ = throwError "Address expected" jumpIf _ [] _ = throwError "Address expected"

2
app/VirtualMachine/VM.hs
View File

@@ -42,7 +42,7 @@ data Op = Nop -- 0x00
| Out -- 0x17 | Out -- 0x17
| Clr -- 0x18 | Clr -- 0x18
| Roll -- 0x19 | Roll -- 0x19
| Over -- 0x20 | Over -- 0x1A
deriving (Eq, Ord, Enum, Show, Read, Bounded) deriving (Eq, Ord, Enum, Show, Read, Bounded)
type Machine = StateT VM IO type Machine = StateT VM IO

67
test/VirtualMachineSpec.hs
View File

@@ -389,23 +389,27 @@ spec = do
it "jumps if top stack value == 0" $ do it "jumps if top stack value == 0" $ do
let input = " push 0 \n\ let input = " push 0 \n\
\ je &jumped \n\ \ je &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 9 (-1) let expected = done [1] 11 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "proceeds if top stack value != 0" $ do it "proceeds if top stack value != 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ je &jumped \n\ \ je &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 6 (-1) let expected = done [0] 7 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "raises error if empty stack" $ do it "raises error if empty stack" $ do
@@ -419,23 +423,27 @@ spec = do
it "jumps if top stack value != 0" $ do it "jumps if top stack value != 0" $ do
let input = " push 4 \n\ let input = " push 4 \n\
\ jne &jumped \n\ \ jne &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 9 (-1) let expected = done [1] 11 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "proceeds if top stack value == 0" $ do it "proceeds if top stack value == 0" $ do
let input = " push 0 \n\ let input = " push 0 \n\
\ jne &jumped \n\ \ jne &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 6 (-1) let expected = done [0] 7 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "raises error if empty stack" $ do it "raises error if empty stack" $ do
@@ -449,35 +457,41 @@ spec = do
it "jumps if top stack value > 0" $ do it "jumps if top stack value > 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ jg &jumped \n\ \ jg &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 9 (-1) let expected = done [1] 11 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "proceeds if top stack value == 0" $ do it "proceeds if top stack value == 0" $ do
let input = " push 0 \n\ let input = " push 0 \n\
\ jg &jumped \n\ \ jg &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 6 (-1) let expected = done [0] 7 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "proceeds if top stack value < 0" $ do it "proceeds if top stack value < 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ neg \n\ \ neg \n\
\ jg &jumped \n\ \ jg &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 7 (-1) let expected = done [0] 8 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "raises error if empty stack" $ do it "raises error if empty stack" $ do
@@ -491,35 +505,41 @@ spec = do
it "proceeds if top stack value > 0" $ do it "proceeds if top stack value > 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ jl &jumped \n\ \ jl &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 6 (-1) let expected = done [0] 7 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "proceeds if top stack value == 0" $ do it "proceeds if top stack value == 0" $ do
let input = " push 0 \n\ let input = " push 0 \n\
\ jl &jumped \n\ \ jl &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 6 (-1) let expected = done [0] 7 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "jumps if top stack value < 0" $ do it "jumps if top stack value < 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ neg \n\ \ neg \n\
\ jl &jumped \n\ \ jl &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 10 (-1) let expected = done [1] 12 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "raises error if empty stack" $ do it "raises error if empty stack" $ do
@@ -533,35 +553,41 @@ spec = do
it "jumps if top stack value > 0" $ do it "jumps if top stack value > 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ jge &jumped \n\ \ jge &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 9 (-1) let expected = done [1] 11 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "jumps if top stack value == 0" $ do it "jumps if top stack value == 0" $ do
let input = " push 0 \n\ let input = " push 0 \n\
\ jge &jumped \n\ \ jge &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 9 (-1) let expected = done [1] 11 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "proceeds if top stack value < 0" $ do it "proceeds if top stack value < 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ neg \n\ \ neg \n\
\ jge &jumped \n\ \ jge &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 7 (-1) let expected = done [0] 8 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "raises error if empty stack" $ do it "raises error if empty stack" $ do
@@ -575,35 +601,41 @@ spec = do
it "proceeds if top stack value > 0" $ do it "proceeds if top stack value > 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ jle &jumped \n\ \ jle &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [0] 6 (-1) let expected = done [0] 7 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "jumps if top stack value == 0" $ do it "jumps if top stack value == 0" $ do
let input = " push 0 \n\ let input = " push 0 \n\
\ jle &jumped \n\ \ jle &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 9 (-1) let expected = done [1] 11 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "jumps if top stack value < 0" $ do it "jumps if top stack value < 0" $ do
let input = " push 1 \n\ let input = " push 1 \n\
\ neg \n\ \ neg \n\
\ jle &jumped \n\ \ jle &jumped \n\
\ pop \n\
\ push 0 \n\ \ push 0 \n\
\ halt \n\ \ halt \n\
\ jumped: \n\ \ jumped: \n\
\ pop \n\
\ push 1 \n\ \ push 1 \n\
\ halt " \ halt "
let expected = done [1] 10 (-1) let expected = done [1] 12 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected
it "raises error if empty stack" $ do it "raises error if empty stack" $ do
@@ -989,9 +1021,8 @@ spec = do
let input = " main: push 100 \n\ let input = " main: push 100 \n\
\ loop: push 1 \n\ \ loop: push 1 \n\
\ sub \n\ \ sub \n\
\ dup \n\
\ jne &loop \n\ \ jne &loop \n\
\ halt " \ halt "
let expected = done [0] 8 (-1) let expected = done [0] 7 (-1)
actual <- run input actual <- run input
actual `shouldBe` expected actual `shouldBe` expected