Browse Source

vmcompiler: prefix labels with current function name

master
Denis Tereshkin 4 years ago
parent
commit
71589f0308
  1. 15
      src/Nand2Tetris/VM.hs

15
src/Nand2Tetris/VM.hs

@ -22,6 +22,7 @@ module Nand2Tetris.VM
import Control.Monad.State.Strict (State, evalState, forM, gets, import Control.Monad.State.Strict (State, evalState, forM, gets,
modify') modify')
import Data.Functor (($>)) import Data.Functor (($>))
import Data.Maybe (fromMaybe)
import qualified Data.Text as T import qualified Data.Text as T
import Nand2Tetris.Error (Error) import Nand2Tetris.Error (Error)
import Nand2Tetris.Hack (HackInstruction (A, C), import Nand2Tetris.Hack (HackInstruction (A, C),
@ -290,16 +291,20 @@ compileInstruction instr = do
compileInstruction' (VMArithmetic ACAnd) = return $ binopSequence SDAndM compileInstruction' (VMArithmetic ACAnd) = return $ binopSequence SDAndM
compileInstruction' (VMArithmetic ACOr) = return $ binopSequence SDOrM compileInstruction' (VMArithmetic ACOr) = return $ binopSequence SDOrM
compileInstruction' (VMArithmetic ACNot) = return $ unopSequence (SNot RegM) compileInstruction' (VMArithmetic ACNot) = return $ unopSequence (SNot RegM)
compileInstruction' (VMBranching (BLabel label)) = return [ALabel label] compileInstruction' (VMBranching (BLabel label)) = do
compileInstruction' (VMBranching (BGoto label)) = fname <- fromMaybe "_Global" <$> gets ceCurrentFunction
return [ Code (A (Label label)), return [ALabel $ fname <> "$" <> label]
compileInstruction' (VMBranching (BGoto label)) = do
fname <- fromMaybe "_Global" <$> gets ceCurrentFunction
return [ Code (A (Label $ fname <> "$" <> label)),
Code (C [] S0 Jmp) Code (C [] S0 Jmp)
] ]
compileInstruction' (VMBranching (BIfGoto label)) = compileInstruction' (VMBranching (BIfGoto label)) = do
fname <- fromMaybe "_Global" <$> gets ceCurrentFunction
return [ Code (A (Label "SP")), return [ Code (A (Label "SP")),
Code (C [RegA, RegM] (SRegMinus1 RegM) JNone), Code (C [RegA, RegM] (SRegMinus1 RegM) JNone),
Code (C [RegD] (SReg RegM) JNone), Code (C [RegD] (SReg RegM) JNone),
Code (A (Label label)), Code (A (Label $ fname <> "$" <> label)),
Code (C [] (SReg RegD) JNe) Code (C [] (SReg RegD) JNe)
] ]
compileInstruction' (VMFunction (FFunction name nvars)) = do compileInstruction' (VMFunction (FFunction name nvars)) = do

Loading…
Cancel
Save