From 74b8de3a4832554d4c0f88435fd22bb20fe04b83 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sat, 18 Dec 2021 22:16:11 +0700 Subject: [PATCH] VM: compile pop instruction --- src/Nand2Tetris/VM.hs | 45 +++++++++++++++++++- test/Test/Nand2Tetris/VM.hs | 83 +++++++++++++++++++++++++++++++++++-- 2 files changed, 124 insertions(+), 4 deletions(-) diff --git a/src/Nand2Tetris/VM.hs b/src/Nand2Tetris/VM.hs index 7d1b95a..bc26942 100644 --- a/src/Nand2Tetris/VM.hs +++ b/src/Nand2Tetris/VM.hs @@ -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 = 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 = 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) ] diff --git a/test/Test/Nand2Tetris/VM.hs b/test/Test/Nand2Tetris/VM.hs index d550723..230a871 100644 --- a/test/Test/Nand2Tetris/VM.hs +++ b/test/Test/Nand2Tetris/VM.hs @@ -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 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 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) ] +