Do more state formatting

Registers can now be displayed above the memory content.

src/Mima/Format/State.hs

@@ -13,6 +13,10 @@ module Mima.Format.State
   , fAddress
   -- * Words
   , fWord
+  -- * Memory
+  , fMemory
+  -- * Registers
+  , fRegisters
   -- * The whole state
   , formatState
   ) where
@@ -30,8 +34,9 @@ import           Mima.Word
 
 data FormatConfig = FormatConfig
   { fcSparse            :: Bool
-  , fcShowRegisterFlags :: Bool
+  , fcShowRegisters     :: Bool
   , fcShowMemoryFlags   :: Bool
+  , fcShowRegisterFlags :: Bool
   , fcShowAddressDec    :: Bool
   , fcShowAddressHex    :: Bool
   , fcShowAddressBin    :: Bool
@@ -108,7 +113,7 @@ fAddress a = do
       hex = if fcShowAddressHex conf then [fAddressHex] else []
       bin = if fcShowAddressBin conf then [fAddressBin] else []
       formats = (dec ++ hex ++ bin) <*> pure a
-  pure $ "[" <> T.intercalate "," formats <> "]"
+  pure $ "[" <> T.intercalate ", " formats <> "]"
 
 {- Words -}
 
@@ -129,7 +134,7 @@ fWord a = do
       hex = if fcShowWordHex conf then [fWordHex] else []
       bin = if fcShowWordBin conf then [fWordBin] else []
       formats = (dec ++ hex ++ bin) <*> pure a
-  pure $ "{" <> T.intercalate "," formats <> "}"
+  pure $ "{" <> T.intercalate ", " formats <> "}"
 
 {- Memory -}
 
@@ -143,18 +148,65 @@ fMemoryLn a = do
   word <- fWord w
   pure $ flags <> " " <> addr <> " " <> word <> "\n"
 
-fMemory :: Formatter
-fMemory = do
+interestingAddresses :: FormatReader (Set.Set MimaAddress)
+interestingAddresses = do
+  env <- ask
+  let conf = feConf env
+      s = feState env
+  pure $ if fcShowRegisterFlags conf
+    then Set.fromList [msIAR s, msRA s, msSP s, msFP s]
+    else Set.empty
+  
+getAddresses :: FormatReader [MimaAddress]
+getAddresses = do
   env <- ask
   let conf = feConf env
       mem = msMemory $ feState env
-      addrs = if fcSparse conf then sparseUsedAddresses mem else usedAddresses mem 
+  if fcSparse conf
+    then do
+      interesting <- interestingAddresses
+      pure $ Set.toAscList $ Set.union interesting $ Set.fromList $ usedAddresses mem
+    else pure $ usedAddresses mem
+
+fMemory :: Formatter
+fMemory = do
+  addrs <- getAddresses
   mconcat <$> mapM fMemoryLn addrs
 
+{- Registers -}
+
+fAddressRegister :: T.Text -> MimaAddress -> Formatter
+fAddressRegister name addr = do
+  addrText <- fAddress addr
+  pure $ name <> ": " <> addrText <> "\n"
+
+fWordRegister :: T.Text -> MimaWord -> Formatter
+fWordRegister name word = do
+  wordText <- fWord word
+  pure $ name <> ": " <> wordText <> "\n"
+
+fRegisters :: Formatter
+fRegisters = do
+  env <- ask
+  let s = feState env
+  mconcat <$> sequenceA [ fAddressRegister "IAR" (msIAR s)
+                        , fWordRegister    "ACC" (msACC s)
+                        , fAddressRegister " RA" (msRA s)
+                        , fAddressRegister " SP" (msSP s)
+                        , fAddressRegister " FP" (msFP s)
+                        ]
+
 {- And finally, the whole state -}
 
 fState :: Formatter
-fState = fMemory
+fState = do
+  env <- ask
+  let conf = feConf env
+  memText <- ("--< MEMORY >--\n"    <>) <$> fMemory
+  regText <- ("--< REGISTERS >--\n" <>) <$> fRegisters
+  pure $ if fcShowRegisters conf
+    then regText <> memText
+    else memText
 
 formatState :: FormatEnv -> T.Text
 formatState = runReader fState

src/Mima/Options.hs

@@ -36,10 +36,12 @@ formatConfigParser :: Parser FormatConfig
 formatConfigParser = FormatConfig
   <$> hiddenSwitchWithNo "sparse" True
       "Omit uninteresting addresses"
+  <*> hiddenSwitchWithNo "registers" True
+      "Show the contents of registers before the memory dump"
+  <*> hiddenSwitchWithNo "memory-flags" False
+      "For each address, show all registers currently pointing to that address"
   <*> hiddenSwitchWithNo "register-flags" True
       "For each address, show all the memory flags that are active for that address"
-  <*> hiddenSwitchWithNo "memory-flags" True
-      "For each address, show all registers currently pointing to that address"
   <*> hiddenSwitchWithNo "address-dec" True
       "Display addresses in decimal"
   <*> hiddenSwitchWithNo "address-hex" True

src/Mima/State.hs

@@ -6,8 +6,9 @@ module Mima.State
   , mapToMemory
   , wordsToMemory
   , memoryToWords
+  , maxAddress
   , usedAddresses
-  , sparseUsedAddresses
+  , continuousUsedAddresses
   , readAt
   , writeAt
   , MimaState(..)
@@ -24,6 +25,7 @@ import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Reader
 import           Data.Bits
 import qualified Data.Map.Strict as Map
+import           Data.Maybe
 import qualified Data.Text as T
 
 import           Mima.Flag
@@ -43,16 +45,16 @@ wordsToMemory = mapToMemory
               . zip [minBound..]
 
 memoryToWords :: MimaMemory -> [MimaWord]
-memoryToWords mem = map (\addr -> readAt addr mem) $ usedAddresses mem
+memoryToWords mem = map (\addr -> readAt addr mem) $ continuousUsedAddresses mem
+
+maxAddress :: MimaMemory -> MimaAddress
+maxAddress (MimaMemory m) = fromMaybe minBound $ fst <$> Map.lookupMax m
 
 usedAddresses :: MimaMemory -> [MimaAddress]
-usedAddresses (MimaMemory m) =
-  case fst <$> Map.lookupMax m of
-    Nothing      -> []
-    Just maxAddr -> [minBound..maxAddr]
+usedAddresses (MimaMemory m) = Map.keys m
 
-sparseUsedAddresses :: MimaMemory -> [MimaAddress]
-sparseUsedAddresses (MimaMemory m) = Map.keys m
+continuousUsedAddresses :: MimaMemory -> [MimaAddress]
+continuousUsedAddresses mem = [minBound..maxAddress mem]
 
 readAt :: MimaAddress -> MimaMemory -> MimaWord
 readAt addr (MimaMemory m) = Map.findWithDefault zeroBits addr m