From af70c1a02cb8eb6e2e80876ccf3ec87f256dba21 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Thu, 7 Nov 2019 16:46:21 +0000
Subject: [PATCH] Print memory dump again

---
 app/MimaRun.hs          | 58 ++++++++++++++++++++++++++++++++++++++---
 src/Mima/Instruction.hs |  6 ++---
 src/Mima/State.hs       |  6 +++++
 3 files changed, 63 insertions(+), 7 deletions(-)

diff --git a/app/MimaRun.hs b/app/MimaRun.hs
index b259ab5..ffb0161 100644
--- a/app/MimaRun.hs
+++ b/app/MimaRun.hs
@@ -1,11 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module MimaRun where
 
 import           Control.Monad
+import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import           Options.Applicative
 
+import           Mima.Instruction
 import           Mima.Load
 import           Mima.State
 import           Mima.Util
@@ -68,6 +71,54 @@ runMima settings s =
         Just e  -> T.putStrLn $ toText e
       pure s'
 
+dumpState :: Bool -> MimaState -> T.Text
+dumpState sparse ms
+  =  registerLegend
+  <> dumpRegisters ms
+  <> memoryLegend
+  <> dumpMemory sparse (msMemory ms)
+  <> footerLegend
+
+showWord :: MimaWord -> T.Text
+showWord w =
+  case wordToInstruction w of
+    Left _  -> wordToHexDec w
+    Right i -> wordToHexDec w <> ": " <> toText i
+
+dumpRegisters :: MimaState -> T.Text
+dumpRegisters MimaState{..}
+  =  "IAR: " <> showAddressRegister msIAR <> "   ->   " <> showWord (readAt msIAR msMemory) <> "\n"
+  <> "ACC: " <> showWordRegister    msACC <> "\n"
+  <> " RA: " <> showAddressRegister msRA  <> "   ->   " <> showWord (readAt msRA  msMemory) <> "\n"
+  <> " SP: " <> showAddressRegister msRA  <> "   ->   " <> showWord (readAt msRA  msMemory) <> "\n"
+  <> " FP: " <> showAddressRegister msRA  <> "   ->   " <> showWord (readAt msRA  msMemory) <> "\n"
+  where
+    showWordRegister w = wordToHex w <> " (" <> wordToDec w <> ")"
+    showAddressRegister lv =
+      " " <> largeValueToHex lv <> " ( " <> largeValueToDec lv <> ")"
+
+registerLegend :: T.Text
+registerLegend = "--------- Register -------------- Target word ---------------\n"
+--               "IAR:  00000 (       0)   ->   800008 ( 8388616): JMP        8"
+
+showMemoryLine :: MimaAddress -> MimaWord -> T.Text
+showMemoryLine addr word = largeValueToHexDec addr <> "   ->   " <> showWord word <> "\n"
+
+dumpMemory :: Bool -> MimaMemory -> T.Text
+dumpMemory sparse mem =
+  let addresses = if sparse then sparseAddressRange mem else addressRange mem
+      memLines = map (\addr -> showMemoryLine addr $ readAt addr mem) addresses
+  in  T.concat memLines
+
+memoryLegend :: T.Text
+memoryLegend = "--- Address ---------------- Word ---------------------------\n"
+--             "00000 (      0)   ->   800008 ( 8388616): JMP        8"
+--             "IAR:  00000 (       0)   ->   800008 ( 8388616): JMP        8"
+
+footerLegend :: T.Text
+footerLegend = "------------------------------------------------------\n"
+--             "00000 (      0)   ->   800008 ( 8388616): JMP        8"
+
 -- TODO exception handling
 main :: IO ()
 main = do
@@ -80,10 +131,9 @@ main = do
   s' <- if norun settings then pure s else runMima settings s
 
   unless (quiet settings) $ do
-    putStrLn "\nDump of memory:"
-    T.putStrLn $ "IP: " <> addrToHexDec (msIp s') <> "     "
-                 <> "Acc: " <> wordToHexDec (msAcc s')
-    T.putStrLn $ memoryToText (sparse settings) (msMemory s')
+    putStrLn ""
+    putStrLn "Dump of MiMa state:"
+    T.putStr $ dumpState (sparse settings) s'
     putStrLn ""
 
   forM_ (memoryDump settings) $ \path -> do
diff --git a/src/Mima/Instruction.hs b/src/Mima/Instruction.hs
index 6e9340a..51ac9c6 100644
--- a/src/Mima/Instruction.hs
+++ b/src/Mima/Instruction.hs
@@ -84,7 +84,7 @@ instance ToText Instruction where
     | otherwise      = T.justifyLeft 4 ' ' (toText oc) <> " " <> smallValueToDec sv
 
 wordToInstruction :: MimaWord -> Either T.Text Instruction
-wordToInstruction mw = if getLargeOpcode mw == 0xF
+wordToInstruction mw = if getSmallOpcode mw == 0xF
                        then parseLargeInstruction mw
                        else parseSmallInstruction mw
 
@@ -99,7 +99,7 @@ parseSmallOpcode :: Word32 -> Either T.Text SmallOpcode
 parseSmallOpcode w = case smallOpcodeMap Map.!? w of
   Just oc -> pure oc
   Nothing -> Left $ "Unknown small opcode " <> T.pack (show w)
-                     <> " (" <> toHex 2 w <> ")"
+                     <> " (" <> toHex 1 w <> ")"
 
 parseLargeInstruction :: MimaWord -> Either T.Text Instruction
 parseLargeInstruction mw = do
@@ -112,4 +112,4 @@ parseLargeOpcode :: Word32 -> Either T.Text LargeOpcode
 parseLargeOpcode w = case largeOpcodeMap Map.!? w of
   Just oc -> pure oc
   Nothing -> Left $ "Unknown large opcode " <> T.pack (show w)
-                     <> " (" <> toHex 2 w <> ")"
+                     <> " (" <> toHex 1 w <> ")"
diff --git a/src/Mima/State.hs b/src/Mima/State.hs
index d7df2e6..ff96971 100644
--- a/src/Mima/State.hs
+++ b/src/Mima/State.hs
@@ -7,6 +7,9 @@ module Mima.State
     MimaMemory
   , readAt
   , writeAt
+  -- ** Querying
+  , addressRange
+  , sparseAddressRange
   -- ** Converting
   , wordsToMemory
   , memoryToWords
@@ -36,6 +39,9 @@ addressRange (MimaMemory m) =
     Nothing      -> []
     Just maxAddr -> [minBound..maxAddr]
 
+sparseAddressRange :: MimaMemory -> [MimaAddress]
+sparseAddressRange (MimaMemory m) = Map.keys m
+
 wordsToMemory :: [MimaWord] -> MimaMemory
 wordsToMemory = MimaMemory
               . Map.filter (/= zeroBits)