diff --git a/app/MimaRun/Main.hs b/app/MimaRun/Main.hs new file mode 100644 index 0000000..463a969 --- /dev/null +++ b/app/MimaRun/Main.hs @@ -0,0 +1,94 @@ +module Main where + +import Control.Monad +import qualified Data.Text.IO as T +import Options.Applicative + +import Mima.Load +import Mima.State +import Mima.Util + +import PrintState + +data Settings = Settings + { infile :: String + , steps :: Maybe Integer + , memoryDump :: Maybe FilePath + , quiet :: Bool + , sparse :: Bool + , norun :: Bool + } deriving (Show) + +{- Command-line parameters -} + +settingsParser :: Parser Settings +settingsParser = Settings + <$> strArgument + (metavar "INFILE" + <> help "The binary memory dump to load and execute") + <*> (optional . option auto) + (long "steps" + <> short 'n' + <> metavar "N" + <> help "How many instructions to execute (if not specified, runs until HALT or execution exception)") + <*> (optional . strOption) + (long "dump" + <> short 'd' + <> metavar "OUTFILE" + <> help "If specified, write the MiMa's binary memory dump to this file after execution is finished") + <*> flag False True + (long "quiet" + <> short 'q' + <> help "Don't print the memory dump") + <*> flag False True + (long "sparse" + <> short 's' + <> help "Don't print memory locations containing only 0x000000 in the memory dump") + <*> flag False True + (long "norun" + <> short 'r' + <> help "Don't run the MiMa. Use the initial state for all further actions") + +opts :: ParserInfo Settings +opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1 + +{- Main logic -} + +runMima :: Settings -> MimaState -> IO MimaState +runMima settings s = + case steps settings of + Nothing -> do + putStrLn "Running until HALT or execution exception..." + let (s', e, x) = run s + putStrLn $ "Ran for " ++ show x ++ " steps" + T.putStrLn $ toText e + pure s' + Just n -> do + let (s', me, x) = runN n s + putStrLn $ "Ran for " ++ show x ++ " steps" + case me of + Nothing -> putStrLn "Encountered no exception" + Just e -> T.putStrLn $ toText e + pure s' + +-- TODO exception handling +main :: IO () +main = do + settings <- execParser opts + + putStrLn $ "Loading memdump at " ++ infile settings + ms <- loadStateFromFile (infile settings) + case ms of + Left errorMsg -> putStrLn errorMsg + Right s -> do + s' <- if norun settings then pure s else runMima settings s + + unless (quiet settings) $ do + putStrLn "" + putStrLn "Dump of MiMa state:" + printStateLn (sparse settings) s' + putStrLn "" + + forM_ (memoryDump settings) $ \path -> do + putStrLn $ "Saving memdump at " ++ path + saveStateToFile path s' diff --git a/app/MimaRun.hs b/app/MimaRun/PrintState.hs similarity index 56% rename from app/MimaRun.hs rename to app/MimaRun/PrintState.hs index 4d81885..ae4bf46 100644 --- a/app/MimaRun.hs +++ b/app/MimaRun/PrintState.hs @@ -1,66 +1,20 @@ {-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -module MimaRun where +module PrintState + ( printStateLn + ) where import Control.Monad import Data.Bits import qualified Data.Text as T import qualified Data.Text.IO as T -import Options.Applicative import System.Console.ANSI import Mima.Instruction -import Mima.Load import Mima.State import Mima.Util import Mima.Word -data Settings = Settings - { infile :: String - , steps :: Maybe Integer - , memoryDump :: Maybe FilePath - , quiet :: Bool - , sparse :: Bool - , norun :: Bool - } deriving (Show) - -{- Command-line parameters -} - -settingsParser :: Parser Settings -settingsParser = Settings - <$> strArgument - (metavar "INFILE" - <> help "The binary memory dump to load and execute") - <*> (optional . option auto) - (long "steps" - <> short 'n' - <> metavar "N" - <> help "How many instructions to execute (if not specified, runs until HALT or execution exception)") - <*> (optional . strOption) - (long "dump" - <> short 'd' - <> metavar "OUTFILE" - <> help "If specified, write the MiMa's binary memory dump to this file after execution is finished") - <*> flag False True - (long "quiet" - <> short 'q' - <> help "Don't print the memory dump") - <*> flag False True - (long "sparse" - <> short 's' - <> help "Don't print memory locations containing only 0x000000 in the memory dump") - <*> flag False True - (long "norun" - <> short 'r' - <> help "Don't run the MiMa. Use the initial state for all further actions") - -opts :: ParserInfo Settings -opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1 - -{- Fancy output -} - printAddress :: Int -> MimaAddress -> IO () printAddress n addr = do T.putStr $ toHexBytes addr @@ -160,44 +114,3 @@ printStateLn :: Bool -> MimaState -> IO () printStateLn sparse ms = do printRegistersLn ms printMemoryLn sparse $ msMemory ms - -{- Main logic -} - -runMima :: Settings -> MimaState -> IO MimaState -runMima settings s = - case steps settings of - Nothing -> do - putStrLn "Running until HALT or execution exception..." - let (s', e, x) = run s - putStrLn $ "Ran for " ++ show x ++ " steps" - T.putStrLn $ toText e - pure s' - Just n -> do - let (s', me, x) = runN n s - putStrLn $ "Ran for " ++ show x ++ " steps" - case me of - Nothing -> putStrLn "Encountered no exception" - Just e -> T.putStrLn $ toText e - pure s' - --- TODO exception handling -main :: IO () -main = do - settings <- execParser opts - - putStrLn $ "Loading memdump at " ++ infile settings - ms <- loadStateFromFile (infile settings) - case ms of - Left errorMsg -> putStrLn errorMsg - Right s -> do - s' <- if norun settings then pure s else runMima settings s - - unless (quiet settings) $ do - putStrLn "" - putStrLn "Dump of MiMa state:" - printStateLn (sparse settings) s' - putStrLn "" - - forM_ (memoryDump settings) $ \path -> do - putStrLn $ "Saving memdump at " ++ path - saveStateToFile path s' diff --git a/package.yaml b/package.yaml index 2063b15..c5a5395 100644 --- a/package.yaml +++ b/package.yaml @@ -33,10 +33,9 @@ library: executables: mima-run: - main: MimaRun.hs - source-dirs: app + main: Main.hs + source-dirs: app/MimaRun ghc-options: - - -main-is MimaRun - -threaded - -rtsopts - -with-rtsopts=-N