Implement subphase5 and complete phase1To2

The program is now able to read simple asm programs and convert them to
a MimaState.
This commit is contained in:
I-Al-Istannen 2020-04-08 20:33:51 +02:00
parent 12801c5627
commit acb49552ed
2 changed files with 61 additions and 3 deletions

View file

@ -3,8 +3,18 @@ module Mima.Asm.Phase2
) where
import qualified Mima.Asm.Phase1 as P1
import Mima.Asm.Phase2.Subphase1
import Mima.Asm.Phase2.Subphase2
import Mima.Asm.Phase2.Subphase3
import Mima.Asm.Phase2.Subphase4
import Mima.Asm.Phase2.Subphase5
import Mima.Asm.Weed
import qualified Mima.Vm.State as Vm
phase1To2 :: P1.Phase1 s -> Weed (WeedError s) Vm.MimaState
phase1To2 = error "to be implemented"
phase1To2 phase1 = do
s1 <- subphase1 phase1
s2 <- subphase2 s1
(s3, labelMap, _) <- subphase3 s2
s4 <- subphase4 labelMap s3
subphase5 s4

View file

@ -0,0 +1,48 @@
{-# LANGUAGE DataKinds #-}
module Mima.Asm.Phase2.Subphase5
( subphase5
) where
import Control.Monad.Trans.State
import Data.Void
import Mima.Asm.Phase2.Types
import Mima.Asm.Weed
import qualified Mima.Vm.Memory as Vm
import qualified Mima.Vm.State as Vm
import qualified Mima.Vm.Word as Vm
type StateS5 = Vm.MimaState
type WeedS5 s = StateT StateS5 (Weed (WeedError s))
wordToVmWord :: MimaWord 'S4 s -> Vm.MimaWord
wordToVmWord (WordLocation addr) = fromIntegral addr
wordToVmWord (WordRaw word) = word
addRegister :: RegisterDirective 'S4 s -> WeedS5 s ()
addRegister (RegIar _ loc) = modify $ \s5 -> s5{Vm.msIar = loc}
addRegister (RegAcc _ word) = modify $ \s5 -> s5{Vm.msAcc = wordToVmWord word}
addRegister (RegRa _ loc) = modify $ \s5 -> s5{Vm.msRa = loc}
addRegister (RegSp _ loc) = modify $ \s5 -> s5{Vm.msSp = loc}
addRegister (RegFp _ loc) = modify $ \s5 -> s5{Vm.msFp = loc}
addToMemory :: Vm.MimaAddress -> Vm.MimaWord -> WeedS5 s ()
addToMemory addr word = do
s5 <- get
let mem = Vm.msMemory s5
put s5{Vm.msMemory = Vm.writeAt addr word mem}
updateToken :: AsmToken 'S4 s -> WeedS5 s ()
updateToken (TokenOrg _ v) = absurd v
updateToken (TokenLabel _ _ v) = absurd v
updateToken (TokenMeta _ _ v) = absurd v
updateToken (TokenLit _ addr word) = addToMemory addr (wordToVmWord word)
updateToken (TokenInstr _ _ v) = absurd v
updateToken (TokenReg _ _ reg) = addRegister reg
subphase5 :: Phase2 'S4 s -> Weed (WeedError s) Vm.MimaState
subphase5 phase2 = execStateT (traverse updateToken phase2) initialS
where
initialS = Vm.basicState (Vm.mapToMemory mempty)