From 957f65c380b4d421500b9084e969e87a63ea8375 Mon Sep 17 00:00:00 2001 From: Joscha Date: Sun, 10 Nov 2019 18:17:21 +0000 Subject: [PATCH] Implement new specification --- app/MimaRun/PrintState.hs | 21 ++++++++++++++------- src/Mima/Assembler/Parser/RawInstruction.hs | 10 +++++++--- src/Mima/Instruction.hs | 19 +++++++++++-------- src/Mima/State.hs | 16 +++++++++++++--- src/Mima/Word.hs | 14 ++++++++++---- 5 files changed, 55 insertions(+), 25 deletions(-) diff --git a/app/MimaRun/PrintState.hs b/app/MimaRun/PrintState.hs index ae4bf46..d3d7f3a 100644 --- a/app/MimaRun/PrintState.hs +++ b/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 diff --git a/src/Mima/Assembler/Parser/RawInstruction.hs b/src/Mima/Assembler/Parser/RawInstruction.hs index b50aef7..c4af572 100644 --- a/src/Mima/Assembler/Parser/RawInstruction.hs +++ b/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 diff --git a/src/Mima/Instruction.hs b/src/Mima/Instruction.hs index fc4ad08..e5521d0 100644 --- a/src/Mima/Instruction.hs +++ b/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] diff --git a/src/Mima/State.hs b/src/Mima/State.hs index f8bc425..7225692 100644 --- a/src/Mima/State.hs +++ b/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 diff --git a/src/Mima/Word.hs b/src/Mima/Word.hs index d30c7ae..459086c 100644 --- a/src/Mima/Word.hs +++ b/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