Implement new specification

app/MimaRun/PrintState.hs

@@ -29,13 +29,19 @@ printWord n word = do
   T.putStr $ T.justifyRight n ' ' $ toDec word
   putStr ")"
 
+-- Color scheme:
+-- Red:    HALT
+-- Yellow: Instructions for accessing other registers
+-- Green:  Instructions that can modify the IAR (jumps)
+-- Blue:   Instructions that read from or write to memory
+-- Cyan:   Logical operations and calculations that modify the ACC
 printInstruction :: Instruction -> IO ()
 printInstruction (SmallInstruction so lv) = do
   setSGR [SetConsoleIntensity BoldIntensity]
-  if | so `elem` [JMP, JMN, CALL]                        -> setSGR [SetColor Foreground Dull Green]
-     | so `elem` [LDC, LDV, STV, LDIV, STIV, LDVR, STVR] -> setSGR [SetColor Foreground Vivid Blue]
-     | so `elem` [ADD, AND, OR, XOR, EQL]                -> setSGR [SetColor Foreground Vivid Cyan]
-     | otherwise                                         -> pure ()
+  if | so `elem` [JMP, JMN, CALL]              -> setSGR [SetColor Foreground Dull Green]
+     | so `elem` [LDC, LDV, STV, LDIV, STIV]   -> setSGR [SetColor Foreground Vivid Blue]
+     | so `elem` [ADD, AND, OR, XOR, EQL, ADC] -> setSGR [SetColor Foreground Vivid Cyan]
+     | otherwise                               -> pure ()
   T.putStr $ toText so
   putStr " "
   setSGR [SetColor Foreground Vivid Black]
@@ -44,12 +50,13 @@ printInstruction (SmallInstruction so lv) = do
 printInstruction (LargeInstruction lo sv) = do
   setSGR [SetConsoleIntensity BoldIntensity]
   if | lo == HALT                                     -> setSGR [SetColor Foreground Vivid Red]
-     | lo == RET                                      -> setSGR [SetColor Foreground Dull Green]
-     | lo `elem` [NOT, RAR, ADC]                      -> setSGR [SetColor Foreground Vivid Cyan]
      | lo `elem` [LDRA, STRA, LDSP, STSP, LDFP, STFP] -> setSGR [SetColor Foreground Dull Yellow]
+     | lo == RET                                      -> setSGR [SetColor Foreground Dull Green]
+     | lo `elem` [LDRS, STRS, LDRF, STRF]             -> setSGR [SetColor Foreground Vivid Blue]
+     | lo `elem` [NOT, RAR]                           -> setSGR [SetColor Foreground Vivid Cyan]
      | otherwise                                      -> pure ()
   T.putStr $ toText lo
-  when (lo == ADC || sv /= zeroBits) $ do
+  when (lo `elem` [LDRS, STRS, LDRF, STRF] || sv /= zeroBits) $ do
     putStr " "
     setSGR [SetColor Foreground Vivid Black]
     T.putStr $ toDec sv

src/Mima/Assembler/Parser/RawInstruction.hs

@@ -27,8 +27,6 @@ parseByLiteral = foldl (<|>) empty . map (\(a, b) -> b <$ C.string' a)
 smallOpcode' :: Parser SmallOpcode
 smallOpcode' = parseByLiteral
   [ ( "LDC",  LDC)
-  , ("LDVR", LDVR) -- Needs to be before LDV
-  , ("STVR", STVR) -- Needs to be before STV
   , ( "LDV",  LDV)
   , ( "STV",  STV)
   , ( "ADD",  ADD)
@@ -41,10 +39,16 @@ smallOpcode' = parseByLiteral
   , ("LDIV", LDIV)
   , ("STIV", STIV)
   , ("CALL", CALL)
+  , ( "ADC",  ADC)
   ]
 
 largeOpcode' :: Parser LargeOpcode
-largeOpcode' = parseByLiteral [( "ADC",  ADC)]
+largeOpcode' = parseByLiteral
+  [ ("STRS", STRS)
+  , ("LDRS", LDRS)
+  , ("STRF", STRF)
+  , ("LDRF", LDRF)
+  ]
 
 largeOptionalOpcode' :: Parser LargeOpcode
 largeOptionalOpcode' = parseByLiteral

src/Mima/Instruction.hs

@@ -15,7 +15,7 @@ import           Mima.Util
 import           Mima.Word
 
 data SmallOpcode = LDC | LDV | STV | ADD | AND | OR | XOR | EQL
-                 | JMP | JMN | LDIV | STIV | CALL | LDVR | STVR
+                 | JMP | JMN | LDIV | STIV | CALL | ADC
   deriving (Show, Eq, Ord)
 
 instance ToText SmallOpcode where
@@ -23,7 +23,7 @@ instance ToText SmallOpcode where
 
 allSmallOpcodes :: [SmallOpcode]
 allSmallOpcodes = [LDC, LDV, STV, ADD, AND, OR, XOR, EQL,
-                   JMP, JMN, LDIV, STIV, CALL, LDVR, STVR]
+                   JMP, JMN, LDIV, STIV, CALL, ADC]
 
 smallOpcodeNr :: SmallOpcode -> Opcode
 smallOpcodeNr LDC  =  0
@@ -39,21 +39,21 @@ smallOpcodeNr JMN  =  9
 smallOpcodeNr LDIV = 10
 smallOpcodeNr STIV = 11
 smallOpcodeNr CALL = 12
-smallOpcodeNr LDVR = 13
-smallOpcodeNr STVR = 14
+smallOpcodeNr ADC  = 13
 
 smallOpcodeMap :: Map.Map Opcode SmallOpcode
 smallOpcodeMap = Map.fromList [(smallOpcodeNr so, so) | so <- allSmallOpcodes]
 
-data LargeOpcode = HALT | NOT | RAR | RET | LDRA | STRA
-                 | LDSP | STSP | LDFP | STFP | ADC
+data LargeOpcode = HALT | NOT | RAR | RET | LDRA | STRA | LDSP | STSP
+                 | LDFP | STFP | LDRS | STRS | LDRF | STRF
   deriving (Show, Eq, Ord)
 
 instance ToText LargeOpcode where
   toText = T.pack . show
 
 allLargeOpcodes :: [LargeOpcode]
-allLargeOpcodes = [HALT, NOT, RAR, RET, LDRA, STRA, LDSP, STSP, LDFP, STFP, ADC]
+allLargeOpcodes = [HALT, NOT, RAR, RET, LDRA, STRA, LDSP, STSP,
+                   LDFP, STFP, LDRS, STRS, LDRF, STRF]
 
 largeOpcodeNr :: LargeOpcode -> Opcode
 largeOpcodeNr HALT =  0
@@ -66,7 +66,10 @@ largeOpcodeNr LDSP =  6
 largeOpcodeNr STSP =  7
 largeOpcodeNr LDFP =  8
 largeOpcodeNr STFP =  9
-largeOpcodeNr ADC  = 10
+largeOpcodeNr LDRS = 10
+largeOpcodeNr STRS = 11
+largeOpcodeNr LDRF = 12
+largeOpcodeNr STRF = 13
 
 largeOpcodeMap :: Map.Map Opcode LargeOpcode
 largeOpcodeMap = Map.fromList [(largeOpcodeNr lo, lo) | lo <- allLargeOpcodes]

src/Mima/State.hs

@@ -122,8 +122,7 @@ doSmallOpcode STIV addr ms@MimaState{..} =
   let indirAddr = getLargeValue $ readAt addr msMemory
   in  ms{msMemory = writeAt indirAddr msACC msMemory}
 doSmallOpcode CALL addr ms@MimaState{..} = ms{msRA = msIAR, msIAR = addr}
-doSmallOpcode LDVR addr ms@MimaState{..} = ms{msACC = readAt (msSP + addr) msMemory}
-doSmallOpcode STVR addr ms@MimaState{..} = ms{msMemory = writeAt (msSP + addr) msACC msMemory}
+doSmallOpcode ADC  lv   ms@MimaState{..} = ms{msACC = msACC + signedLargeValueToWord lv}
 
 doLargeOpcode :: LargeOpcode -> SmallValue -> MimaState -> Either AbortReason MimaState
 doLargeOpcode HALT _  _                = Left Halted
@@ -136,7 +135,18 @@ doLargeOpcode LDSP _  ms@MimaState{..} = pure ms{msACC = largeValueToWord msSP}
 doLargeOpcode STSP _  ms@MimaState{..} = pure ms{msSP  = getLargeValue msACC}
 doLargeOpcode LDFP _  ms@MimaState{..} = pure ms{msACC = largeValueToWord msFP}
 doLargeOpcode STFP _  ms@MimaState{..} = pure ms{msFP  = getLargeValue msACC}
-doLargeOpcode ADC  sv ms@MimaState{..} = pure ms{msACC = msACC + signedSmallValueToWord sv}
+doLargeOpcode LDRS sv ms@MimaState{..} =
+  let indirAddr = msSP + signedSmallValueToLargeValue sv
+  in  pure ms{msACC = readAt indirAddr msMemory}
+doLargeOpcode STRS sv ms@MimaState{..} =
+  let indirAddr = msSP + signedSmallValueToLargeValue sv
+  in  pure ms{msMemory = writeAt indirAddr msACC msMemory}
+doLargeOpcode LDRF sv ms@MimaState{..} =
+  let indirAddr = msFP + signedSmallValueToLargeValue sv
+  in  pure ms{msACC = readAt indirAddr msMemory}
+doLargeOpcode STRF sv ms@MimaState{..} =
+  let indirAddr = msFP + signedSmallValueToLargeValue sv
+  in  pure ms{msMemory = writeAt indirAddr msACC msMemory}
 
 run :: MimaState -> (MimaState, AbortReason, Integer)
 run ms = helper 0 ms

src/Mima/Word.hs

@@ -12,7 +12,8 @@ module Mima.Word
   , wordToBytes
   , boolToWord
   , largeValueToWord
-  , signedSmallValueToWord
+  , signedLargeValueToWord
+  , signedSmallValueToLargeValue
   , wordFromSmallOpcode
   , wordFromLargeOpcode
   -- ** 'MimaWord' properties
@@ -56,9 +57,14 @@ boolToWord True = complement zeroBits
 largeValueToWord :: LargeValue -> MimaWord
 largeValueToWord = fromIntegral
 
-signedSmallValueToWord :: SmallValue -> MimaWord
-signedSmallValueToWord sv
-  | topBit sv = 0xFF0000 .|. fromIntegral sv
+signedLargeValueToWord :: LargeValue -> MimaWord
+signedLargeValueToWord lv
+  | topBit lv = 0xF00000 .|. fromIntegral lv
+  | otherwise = fromIntegral lv
+
+signedSmallValueToLargeValue :: SmallValue -> LargeValue
+signedSmallValueToLargeValue sv
+  | topBit sv = 0xF0000 .|. fromIntegral sv
   | otherwise = fromIntegral sv
 
 wordFromSmallOpcode :: Opcode -> LargeValue -> MimaWord