Permalink
Browse files

Add pretty log

  • Loading branch information...
jaspervdj committed Apr 10, 2012
1 parent 9518742 commit d6e90f24d509283d42c5ce48e8ed779ca9265eeb
Showing with 110 additions and 61 deletions.
  1. +1 −0 dcpu16-hs.cabal
  2. +24 −55 src/Emulator.hs
  3. +59 −0 src/Emulator/Log.hs
  4. +5 −2 src/Emulator/Main.hs
  5. +2 −2 src/Emulator/Monad/IO.hs
  6. +19 −2 src/Instruction.hs
View
@@ -17,6 +17,7 @@ Executable dcpu16-emulator
Other-modules:
Emulator
Emulator.Log
Emulator.Monad
Emulator.Monad.ST
Emulator.Monad.IO
View
@@ -1,15 +1,15 @@
{-# LANGUAGE BangPatterns, Rank2Types #-}
module Emulator
( loadProgram
( Value (..)
, loadProgram
, emulate
, emulateWith
, loadInstruction
, loadOperands
, execute
, prettify
) where
import Control.Applicative ((<$>))
import Control.Monad (forM)
import Data.Bits (shiftL, shiftR, xor, (.&.), (.|.))
import Data.Word (Word, Word16)
@@ -21,6 +21,16 @@ import Instruction
import Memory (Address (..))
import Util
-- | After we load an operand, we get a value. This is either an address (we
-- can write back to) or a literal value.
data Value
= Address Address
| Literal Word16
instance Show Value where
show (Address a) = "[" ++ show a ++ "]"
show (Literal l) = prettifyWord16 l
-- | Load a program from a bytestring
loadProgram :: MonadEmulator m => ByteString -> m ()
loadProgram bs = loop 0
@@ -48,13 +58,6 @@ addCycles c = do
cycles <- load Cycles
store Cycles (cycles + fromIntegral c)
-- | After we load an operand, we get a value. This is either an address (we
-- can write back to) or a literal value.
data Value
= Address Address
| Literal Word16
deriving (Show)
loadOperand :: MonadEmulator m => Operand -> m Value
loadOperand (ORegister reg) =
return $ Address $ Register reg
@@ -99,15 +102,22 @@ storeValue :: MonadEmulator m => Value -> Word16 -> m ()
storeValue (Address address) val = store address val
storeValue (Literal _) _ = return ()
-- | Stops when an unknown instruction is encountered
emulate :: MonadEmulator m => m ()
emulate = do
emulate = emulateWith $ const $ const $ return ()
-- | Stops when an unknown instruction is encountered
emulateWith :: MonadEmulator m
=> (Instruction Operand -> Instruction Value -> m ())
-> m ()
emulateWith callback = do
instr <- loadInstruction
case instr of
UnknownInstruction _ -> return ()
_ -> do
loadOperands instr >>= execute instr
emulate
instr' <- loadOperands instr
execute instr instr'
callback instr instr'
emulateWith callback
loadInstruction :: MonadEmulator m => m (Instruction Operand)
loadInstruction = decodeInstruction <$> loadNextWord
@@ -227,44 +237,3 @@ execute' (NonBasicInstruction Jsr a) = do
store Pc x -- Set PC to a (jump)
execute' (UnknownInstruction _) =
return ()
prettify :: MonadEmulator m => m String
prettify = unlines . concat <$>
sequence [prettifyEmulator, prettifyRegister, prettifyRam]
prettifyEmulator :: MonadEmulator m => m [String]
prettifyEmulator = do
pc <- load Pc
sp <- load Sp
o <- load O
skip <- load Skip
cycles <- load Cycles
return $
[ "EMULATOR"
, ""
, "PC: " ++ prettifyWord16 pc
, "SP: " ++ prettifyWord16 sp
, "O: " ++ prettifyWord16 o
, "SKIP: " ++ prettifyWord16 skip
, "CYCLES: " ++ prettifyWord16 cycles
, ""
]
prettifyRegister :: MonadEmulator m => m [String]
prettifyRegister = do
registers <- forM [minBound .. maxBound] $ \name -> do
val <- load (Register name)
return (name, val)
return $
["REGISTER", ""] ++
[show name ++ ": " ++ prettifyWord16 val | (name, val) <- registers] ++
[""]
prettifyRam :: MonadEmulator m => m [String]
prettifyRam = do
ls <- mapM line [(x * 8, x * 8 + 7) | x <- [0 .. 0xffff `div` 8]]
return $ ["RAM", ""] ++ ls ++ [""]
where
line (lo, up) = do
vals <- mapM (load . Ram) [lo .. up]
return $ prettifyWord16 lo ++ ": " ++ unwords (map prettifyWord16 vals)
View
@@ -0,0 +1,59 @@
-- | Simple prettified log
module Emulator.Log
( prettify
, state
, core
, registers
, ram
) where
import Control.Applicative ((<$>))
import Control.Monad (forM)
import Data.List (intercalate)
import Emulator
import Emulator.Monad
import Instruction
import Memory (Address (..))
import Util
prettify :: MonadEmulator m => m String
prettify = unlines <$> sequence
[core , registers , return "" , return "RAM:" , return "" , ram]
state :: MonadEmulator m => Instruction Operand -> Instruction Value -> m String
state instr instr' = unlines <$> sequence
[ return $ "Execute: " ++ show instr ++ " -> " ++ show instr'
, core
, registers
]
core :: MonadEmulator m => m String
core = do
pc <- load Pc
sp <- load Sp
o <- load O
skip <- load Skip
cycles <- load Cycles
return $ intercalate ", " $
[ "PC: " ++ prettifyWord16 pc
, "SP: " ++ prettifyWord16 sp
, "O: " ++ prettifyWord16 o
, "SKIP: " ++ prettifyWord16 skip
, "CYCLES: " ++ prettifyWord16 cycles
]
registers :: MonadEmulator m => m String
registers = do
rs <- forM [minBound .. maxBound] $ \name -> do
val <- load (Register name)
return (name, val)
return $ intercalate ", " $
[show name ++ ": " ++ prettifyWord16 val | (name, val) <- rs]
ram :: MonadEmulator m => m String
ram = unlines <$> mapM line [(x * 8, x * 8 + 7) | x <- [0 .. 0xffff `div` 8]]
where
line (lo, up) = do
vs <- mapM (load . Ram) [lo .. up]
return $ prettifyWord16 lo ++ ": " ++ unwords (map prettifyWord16 vs)
View
@@ -1,13 +1,16 @@
{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
module Main where
import Control.Monad.Trans (liftIO)
import Data.Foldable (forM_)
import Prelude hiding (log)
import System.Console.CmdArgs
import qualified Data.ByteString as B
import Emulator
import Emulator.Monad.IO
import qualified Emulator.Log as Log
data Config = Config
{ pretty :: Maybe FilePath
@@ -26,7 +29,7 @@ main = do
program' <- B.readFile (binary config')
pretty' <- runIOEmulator $ do
loadProgram program'
emulate
prettify
emulateWith (\i i' -> Log.state i i' >>= liftIO . putStrLn)
Log.prettify
forM_ (pretty config') $ \path -> writeFile path pretty'
View
@@ -8,15 +8,15 @@ module Emulator.Monad.IO
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Control.Monad.ST (RealWorld, stToIO)
import Control.Monad.Trans (lift)
import Control.Monad.Trans (MonadIO, lift)
import Emulator.Monad
import Emulator.Video
import Memory (Memory)
import qualified Memory as Memory
newtype IOEmulator a = IOEmulator (ReaderT (Memory RealWorld) IO a)
deriving (Functor, Monad)
deriving (Functor, Monad, MonadIO)
instance MonadEmulator IOEmulator where
load address = IOEmulator $ do
View
@@ -43,7 +43,11 @@ data Instruction a
= BasicInstruction BasicInstruction a a
| NonBasicInstruction NonBasicInstruction a
| UnknownInstruction Word16
deriving (Show)
instance Show a => Show (Instruction a) where
show (BasicInstruction op a b) = unwords [show op, show a, show b]
show (NonBasicInstruction op a) = unwords [show op, show a]
show (UnknownInstruction w) = "??? (" ++ show w ++ ")"
decodeInstruction :: Word16 -> Instruction Operand
decodeInstruction word = case oooo of
@@ -146,7 +150,20 @@ data Operand
| OO
| OPNextWord
| ONextWord
deriving (Show)
instance Show Operand where
show (ORegister r) = show r
show (OPRegister r) = "[" ++ show r ++ "]"
show (OPNextWordPlusRegister r) = "[next word + " ++ show r ++ "]"
show (OLiteral l) = prettifyWord16 l
show OPop = "Pop"
show OPeek = "Peek"
show OPush = "Push"
show OSp = "Sp"
show OPc = "Pc"
show OO = "O"
show OPNextWord = "[next word]"
show ONextWord = "(next word)"
-- | Only looks at the 6 least significant bits
decodeOperand :: Word16 -> Operand

0 comments on commit d6e90f2

Please sign in to comment.