asakul
/
nand2tetris
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

VM: compile pop instruction

master
Denis Tereshkin 4 years ago
parent
7e6115352c
commit
74b8de3a48
2 changed files with 124 additions and 4 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 45
      src/Nand2Tetris/VM.hs
  2. 83
      test/Test/Nand2Tetris/VM.hs

45
src/Nand2Tetris/VM.hs
Unescape View File

@ -18,7 +18,7 @@ import qualified Data.Text as T @@ -18,7 +18,7 @@ import qualified Data.Text as T
import Text.Megaparsec.Char (string, space1, letterChar, alphaNumChar, char)
import Data.Functor (($>))
import qualified Text.Megaparsec.Char.Lexer as L
import Nand2Tetris.Hack (HackInstruction (A, C), Imm (Label, Imm), Reg (RegD, RegA, RegM), Source (SReg, SDPlusA, SRegPlus1), Jump (JNone))
import Nand2Tetris.Hack (HackInstruction (A, C), Imm (Label, Imm), Reg (RegD, RegA, RegM), Source (SReg, SDPlusA, SRegPlus1, SRegMinus1, SDPlusM), Jump (JNone))
data VMInstruction =
VMArithmetic ArithmeticCmd
@ -169,6 +169,17 @@ compileInstruction instr = @@ -169,6 +169,17 @@ compileInstruction instr =
Code (A (Label "SP")),
Code (C [RegM] (SReg RegD) JNone) ]
compileInstruction' (VMMemAccess ACPop segment) =
case segment of
SLocal offset -> popSeq "LCL" offset
SArgument offset -> popSeq "ARG" offset
SThis offset -> popSeq "THIS" offset
SThat offset -> popSeq "THAT" offset
SConstant _ -> error "Pop constant instruction"
SStatic label -> popLabelValue label
SPointer offset -> if offset == 0 then popLabelValue "THIS" else popLabelValue "THAT"
STemp offset -> popRam (5 + offset)
pushLabelValue label = [
Code (A . Label $ label),
@ -193,3 +204,35 @@ compileInstruction instr = @@ -193,3 +204,35 @@ compileInstruction instr =
Code (C [RegD] (SRegPlus1 RegA) JNone),
Code (A (Label "SP")),
Code (C [RegM] (SReg RegD) JNone) ]
popSeq regName offset = [
Code (A (Label "SP")),
Code (C [RegM] (SRegMinus1 RegM) JNone),
Code (A (Imm offset)),
Code (C [RegD] (SReg RegA) JNone),
Code (A (Label regName)),
Code (C [RegA] SDPlusM JNone),
Code (C [RegD] (SReg RegM) JNone),
Code (A (Label "SP")),
Code (C [RegA] (SReg RegM) JNone),
Code (C [RegM] (SReg RegD) JNone)
]
popLabelValue label = [
Code (A (Label "SP")),
Code (C [RegM] (SRegMinus1 RegM) JNone),
Code (C [RegA] (SReg RegM) JNone),
Code (C [RegD] (SReg RegM) JNone),
Code (A . Label $ label),
Code (C [RegM] (SReg RegD) JNone) ]
popRam offset = [
Code (A (Label "SP")),
Code (C [RegM] (SRegMinus1 RegM) JNone),
Code (C [RegA] (SReg RegM) JNone),
Code (C [RegD] (SReg RegM) JNone),
Code (A . Imm $ offset),
Code (C [RegM] (SReg RegD) JNone) ]

83
test/Test/Nand2Tetris/VM.hs
Unescape View File

@ -21,7 +21,8 @@ import Text.Megaparsec (runParser) @@ -21,7 +21,8 @@ import Text.Megaparsec (runParser)
spec :: Spec
spec = do
describe "parseInstruction" parseInstructionSpec
describe "compileInstruction" compileInstructionSpec
describe "compile push instruction" compilePushInstructionSpec
describe "compile pop instruction" compilePopInstructionSpec
parseInstructionSpec :: Spec
parseInstructionSpec = do
@ -85,8 +86,8 @@ parseInstructionSpec = do @@ -85,8 +86,8 @@ parseInstructionSpec = do
where
doParse = runParser parseInstruction ""
compileInstructionSpec :: Spec
compileInstructionSpec = do
compilePushInstructionSpec :: Spec
compilePushInstructionSpec = do
it "Compiles push argument 42" $ do
let compiled = compileInstruction (VMMemAccess ACPush (SArgument 42))
head compiled `shouldBe` (Comment "push argument 42")
@ -172,3 +173,79 @@ compileInstructionSpec = do @@ -172,3 +173,79 @@ compileInstructionSpec = do
Code (C [RegM] (SReg RegD) JNone) ]
compilePopInstructionSpec :: Spec
compilePopInstructionSpec = do
it "pop argument 42" $ do
let compiled = compileInstruction (VMMemAccess ACPop (SArgument 42))
head compiled `shouldBe` (Comment "pop argument 42")
tail compiled `shouldBe` popValue "ARG" 42
it "pop local 42" $ do
let compiled = compileInstruction (VMMemAccess ACPop (SLocal 42))
head compiled `shouldBe` (Comment "pop local 42")
tail compiled `shouldBe` popValue "LCL" 42
it "pop this 42" $ do
let compiled = compileInstruction (VMMemAccess ACPop (SThis 42))
head compiled `shouldBe` (Comment "pop this 42")
tail compiled `shouldBe` popValue "THIS" 42
it "pop that 42" $ do
let compiled = compileInstruction (VMMemAccess ACPop (SThat 42))
head compiled `shouldBe` (Comment "pop that 42")
tail compiled `shouldBe` popValue "THAT" 42
it "pop static Foo.1" $ do
let compiled = compileInstruction (VMMemAccess ACPop (SStatic "Foo.1"))
head compiled `shouldBe` (Comment "pop static Foo.1")
tail compiled `shouldBe` popLabelValue "Foo.1"
it "pop pointer 0" $ do
let compiled = compileInstruction (VMMemAccess ACPop (SPointer 0))
head compiled `shouldBe` (Comment "pop pointer 0")
tail compiled `shouldBe` popLabelValue "THIS"
it "pop pointer 1" $ do
let compiled = compileInstruction (VMMemAccess ACPop (SPointer 1))
head compiled `shouldBe` (Comment "pop pointer 1")
tail compiled `shouldBe` popLabelValue "THAT"
it "pop temp 1" $ do
let compiled = compileInstruction (VMMemAccess ACPop (STemp 1))
head compiled `shouldBe` (Comment "pop temp 1")
tail compiled `shouldBe` popRam (5 + 1)
where
popValue reg value = [
Code (A (Label "SP")),
Code (C [RegM] (SRegMinus1 RegM) JNone),
Code (A (Imm value)),
Code (C [RegD] (SReg RegA) JNone),
Code (A (Label reg)),
Code (C [RegA] SDPlusM JNone),
Code (C [RegD] (SReg RegM) JNone),
Code (A (Label "SP")),
Code (C [RegA] (SReg RegM) JNone),
Code (C [RegM] (SReg RegD) JNone)
]
popLabelValue label = [
Code (A (Label "SP")),
Code (C [RegM] (SRegMinus1 RegM) JNone),
Code (C [RegA] (SReg RegM) JNone),
Code (C [RegD] (SReg RegM) JNone),
Code (A . Label $ label),
Code (C [RegM] (SReg RegD) JNone) ]
popRam offset = [
Code (A (Label "SP")),
Code (C [RegM] (SRegMinus1 RegM) JNone),
Code (C [RegA] (SReg RegM) JNone),
Code (C [RegD] (SReg RegM) JNone),
Code (A . Imm $ offset),
Code (C [RegM] (SReg RegD) JNone) ]

Write Preview
Loading…
Cancel
Save