Implement most of mima-run CLI

This commit is contained in:
Joscha 2019-11-06 17:20:08 +00:00
parent a1f532172a
commit 082a205a7e
3 changed files with 57 additions and 12 deletions

View file

@ -1,17 +1,24 @@
module MimaRun where module MimaRun where
import Control.Monad
import qualified Data.Text.IO as T
import Options.Applicative import Options.Applicative
import Mima.Load
import Mima.State
import Mima.Util
data Settings = Settings data Settings = Settings
{ file :: String { infile :: String
, steps :: Maybe Integer , steps :: Maybe Integer
, memoryDump :: Maybe FilePath , memoryDump :: Maybe FilePath
, quiet :: Bool , quiet :: Bool
, sparseOutput :: Bool , sparse :: Bool
, norun :: Bool
} deriving (Show) } deriving (Show)
settings :: Parser Settings settingsParser :: Parser Settings
settings = Settings settingsParser = Settings
<$> strArgument <$> strArgument
(metavar "INFILE" (metavar "INFILE"
<> help "The memory dump to load and execute") <> help "The memory dump to load and execute")
@ -33,9 +40,41 @@ settings = Settings
(long "sparse" (long "sparse"
<> short 's' <> short 's'
<> help "Whether to print memory locations that contain 0") <> help "Whether to print memory locations that contain 0")
<*> flag False True
(long "norun"
<> short 'r'
<> help "Don't run the MiMa. Continues as if the initial state was the result of running the MiMa.")
opts :: ParserInfo Settings opts :: ParserInfo Settings
opts = info (helper <*> settings) $ fullDesc <> failureCode 1 opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1
runMima :: Settings -> MimaState -> IO MimaState
runMima settings s =
case steps settings of
Nothing -> do
putStrLn "Running until HALT or execution exception..."
let (s', e) = run s
T.putStrLn $ toText e
pure s'
Just _ -> do
putStrLn "This option is currently not supported"
undefined
-- TODO exception handling
main :: IO () main :: IO ()
main = execParser opts >>= print main = do
settings <- execParser opts
putStrLn $ "Loading memdump at " ++ infile settings
mem <- loadMemoryFromFile (infile settings)
let s = initialState mem
s' <- if norun settings then pure s else runMima settings s
unless (quiet settings) $ do
putStrLn "Dump of memory:"
T.putStrLn $ memoryToText (sparse settings) (msMemory s')
forM_ (memoryDump settings) $ \path -> do
putStrLn $ "Saving memdump at " ++ path
saveMemoryToFile path $ msMemory s'

View file

@ -63,7 +63,7 @@ data Instruction
deriving (Show, Eq) deriving (Show, Eq)
instance ToText Instruction where instance ToText Instruction where
toText (SmallInstruction oc addr) = toText oc <> " 0x" <> addrToHex addr toText (SmallInstruction oc addr) = T.justifyLeft 4 ' ' (toText oc) <> " " <> addrToDec addr
toText (LargeInstruction oc) = toText oc toText (LargeInstruction oc) = toText oc

View file

@ -43,7 +43,13 @@ memoryToWords mem = map (\addr -> readAt addr mem) $ addressRange mem
addressWordToText :: MimaAddress -> MimaWord -> T.Text addressWordToText :: MimaAddress -> MimaWord -> T.Text
addressWordToText addr word = addressWordToText addr word =
addrToHex addr <> " (" <> addrToDec addr <> ") - " <> wordToHex word <> " (" <> wordToDec word <> ")" let separator = " - "
addrText = addrToHex addr <> " (" <> addrToDec addr <> ")"
wordText = wordToHex word <> " (" <> wordToDec word <> ")"
instrText = case wordToInstruction word of
Left _ -> ""
Right i -> separator <> toText i
in addrText <> separator <> wordText <> instrText
memoryToText :: Bool -> MimaMemory -> T.Text memoryToText :: Bool -> MimaMemory -> T.Text
memoryToText sparse mem@(MimaMemory m) memoryToText sparse mem@(MimaMemory m)