Parse register contents at beginning of file

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
+  unresolvedRegisters <- parseRegisters
-  rawInstructions <- resolveLabels labels rawLabeledInstructions
+  (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)

src/Mima/Assembler/Parser/Label.hs

@@ -1,5 +1,6 @@
 module Mima.Assembler.Parser.Label
   ( MimaLabel
+  , lName
   , mimaLabel
   , mimaLabel'
   , failAtLabel

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)