Clean up application file structure
This commit is contained in:
parent
4f5817c032
commit
9258aa4f4d
3 changed files with 99 additions and 93 deletions
94
app/MimaRun/Main.hs
Normal file
94
app/MimaRun/Main.hs
Normal file
|
|
@ -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'
|
||||||
|
|
@ -1,66 +1,20 @@
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
|
|
||||||
module MimaRun where
|
module PrintState
|
||||||
|
( printStateLn
|
||||||
|
) where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import Options.Applicative
|
|
||||||
import System.Console.ANSI
|
import System.Console.ANSI
|
||||||
|
|
||||||
import Mima.Instruction
|
import Mima.Instruction
|
||||||
import Mima.Load
|
|
||||||
import Mima.State
|
import Mima.State
|
||||||
import Mima.Util
|
import Mima.Util
|
||||||
import Mima.Word
|
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 :: Int -> MimaAddress -> IO ()
|
||||||
printAddress n addr = do
|
printAddress n addr = do
|
||||||
T.putStr $ toHexBytes addr
|
T.putStr $ toHexBytes addr
|
||||||
|
|
@ -160,44 +114,3 @@ printStateLn :: Bool -> MimaState -> IO ()
|
||||||
printStateLn sparse ms = do
|
printStateLn sparse ms = do
|
||||||
printRegistersLn ms
|
printRegistersLn ms
|
||||||
printMemoryLn sparse $ msMemory 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'
|
|
||||||
|
|
@ -33,10 +33,9 @@ library:
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
mima-run:
|
mima-run:
|
||||||
main: MimaRun.hs
|
main: Main.hs
|
||||||
source-dirs: app
|
source-dirs: app/MimaRun
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -main-is MimaRun
|
|
||||||
- -threaded
|
- -threaded
|
||||||
- -rtsopts
|
- -rtsopts
|
||||||
- -with-rtsopts=-N
|
- -with-rtsopts=-N
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue