diff --git a/src/Mima/Asm/Phase2.hs b/src/Mima/Asm/Phase2.hs index 64cdefe..b6e2303 100644 --- a/src/Mima/Asm/Phase2.hs +++ b/src/Mima/Asm/Phase2.hs @@ -2,9 +2,19 @@ module Mima.Asm.Phase2 ( phase1To2 ) where -import qualified Mima.Asm.Phase1 as P1 +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 +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 diff --git a/src/Mima/Asm/Phase2/Subphase5.hs b/src/Mima/Asm/Phase2/Subphase5.hs new file mode 100644 index 0000000..93cebe2 --- /dev/null +++ b/src/Mima/Asm/Phase2/Subphase5.hs @@ -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)