diff --git a/src/Mima/Assembler/Parser.hs b/src/Mima/Assembler/Parser.hs index 421d5c3..e08f6ed 100644 --- a/src/Mima/Assembler/Parser.hs +++ b/src/Mima/Assembler/Parser.hs @@ -8,13 +8,16 @@ import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.State import qualified Data.Map as Map +import Data.Maybe import qualified Data.Set as Set +import qualified Data.Text as T import Text.Megaparsec import Mima.Assembler.Parser.Basic import Mima.Assembler.Parser.Instruction import Mima.Assembler.Parser.Label import Mima.Assembler.Parser.RawInstruction +import Mima.Assembler.Parser.Register import Mima.State import Mima.Word @@ -58,6 +61,20 @@ parseInstructions = do (_, s) <- runStatefulParser parseInstructions' initialState pure (sLabels s, sInstructions s) +resolveRegisters :: Map.Map MimaLabel MimaAddress + -> Registers Address + -> Parser (Registers MimaAddress) +resolveRegisters labels reg = do + iar <- resolveMaybeAddress $ regIAR reg + ra <- resolveMaybeAddress $ regRA reg + sp <- resolveMaybeAddress $ regSP reg + fp <- resolveMaybeAddress $ regFP reg + pure reg{regIAR = iar, regRA = ra, regSP = sp, regFP = fp} + where + resolveMaybeAddress :: Maybe Address -> Parser (Maybe MimaAddress) + resolveMaybeAddress (Just addr) = Just <$> resolveAddress labels addr + resolveMaybeAddress Nothing = pure Nothing + resolveRawInstruction :: Map.Map MimaLabel MimaAddress -> RawInstruction Address -> Parser (RawInstruction MimaAddress) @@ -77,10 +94,23 @@ resolveLabels labels rawLabeledInstructions = do let rawInstructions = Map.fromList instrList pure rawInstructions -parseState :: Parser MimaState +stateFromRegisters :: Registers MimaAddress -> MimaMemory -> MimaState +stateFromRegisters reg mem = + MimaState { msIAR = fromMaybe 0 $ regIAR reg + , msACC = fromMaybe 0 $ regACC reg + , msRA = fromMaybe 0 $ regRA reg + , msSP = fromMaybe 0 $ regSP reg + , msFP = fromMaybe 0 $ regFP reg + , msMemory = mem + } + +parseState :: Parser (MimaState, Map.Map T.Text MimaAddress) parseState = do space - (labels, rawLabeledInstructions) <- parseInstructions - rawInstructions <- resolveLabels labels rawLabeledInstructions + unresolvedRegisters <- parseRegisters + (labels, unresolvedRawInstructions) <- parseInstructions + registers <- resolveRegisters labels unresolvedRegisters + rawInstructions <- resolveLabels labels unresolvedRawInstructions let mem = mapToMemory $ Map.map rawInstructionToWord rawInstructions - pure $ basicState mem + labelNames = Map.fromList $ map (\(k, v) -> (lName k, v)) $ Map.toList labels + pure (stateFromRegisters registers mem, labelNames) diff --git a/src/Mima/Assembler/Parser/Label.hs b/src/Mima/Assembler/Parser/Label.hs index 11b85d0..029ad8a 100644 --- a/src/Mima/Assembler/Parser/Label.hs +++ b/src/Mima/Assembler/Parser/Label.hs @@ -1,5 +1,6 @@ module Mima.Assembler.Parser.Label ( MimaLabel + , lName , mimaLabel , mimaLabel' , failAtLabel diff --git a/src/Mima/Assembler/Parser/Register.hs b/src/Mima/Assembler/Parser/Register.hs new file mode 100644 index 0000000..14f0a02 --- /dev/null +++ b/src/Mima/Assembler/Parser/Register.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Mima.Assembler.Parser.Register + ( Registers(..) + , parseRegisters + ) where + +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.State +import qualified Data.Text as T +import Text.Megaparsec +import qualified Text.Megaparsec.Char as C + +import Mima.Assembler.Parser.Basic +import Mima.Assembler.Parser.Label +import Mima.Word + +data Registers addr = Registers + { regIAR :: Maybe addr + , regACC :: Maybe MimaWord + , regRA :: Maybe addr + , regSP :: Maybe addr + , regFP :: Maybe addr + } deriving (Show) + +emptyRegisters :: Registers a +emptyRegisters = Registers Nothing Nothing Nothing Nothing Nothing + +parseRegisters :: Parser (Registers Address) +parseRegisters = snd <$> runStatefulParser parseRegisters' emptyRegisters + +parseRegisters' :: StatefulParser (Registers Address) () +parseRegisters' = (parseARegister >> lift newlines >> parseRegisters') <|> pure () + +parseARegister :: StatefulParser (Registers Address) () +parseARegister + = parseRegister "IAR" address regIAR (\v reg -> reg{regIAR = Just v}) + <|> parseRegister "ACC" mimaWord regACC (\v reg -> reg{regACC = Just v}) + <|> parseRegister "RA" address regRA (\v reg -> reg{regRA = Just v}) + <|> parseRegister "SP" address regSP (\v reg -> reg{regSP = Just v}) + <|> parseRegister "FP" address regFP (\v reg -> reg{regFP = Just v}) + "register initialisation" + +parseRegister :: T.Text + -> Parser x + -> (Registers addr -> Maybe x) + -> (x -> Registers addr -> Registers addr) + -> StatefulParser (Registers addr) () +parseRegister name parser readReg writeReg = do + void $ lift $ lexeme $ C.string' name + void $ lift $ lexeme $ C.string' "=" + reg <- get + case readReg reg of + Just _ -> fail $ "can't specify register " ++ T.unpack name ++ " twice" + Nothing -> do + x <- lift parser + modify (writeReg x)