From 2010894a3ad6ba149549c72740520537c185294c Mon Sep 17 00:00:00 2001
From: Langston Barrett <langston.barrett@gmail.com>
Date: Thu, 19 Dec 2024 15:49:23 -0500
Subject: [PATCH] dump: Flag to dump the content of memory

---
 macaw-dump/src/Data/Macaw/Dump/Memory.hs | 56 +++++++++++++++++++++++-
 1 file changed, 54 insertions(+), 2 deletions(-)

diff --git a/macaw-dump/src/Data/Macaw/Dump/Memory.hs b/macaw-dump/src/Data/Macaw/Dump/Memory.hs
index ea0c4a43..5a2ed934 100644
--- a/macaw-dump/src/Data/Macaw/Dump/Memory.hs
+++ b/macaw-dump/src/Data/Macaw/Dump/Memory.hs
@@ -1,7 +1,8 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE FlexibleContexts #-}
 
 module Data.Macaw.Dump.Memory
   ( MemoryConfig(..)
@@ -9,6 +10,8 @@ module Data.Macaw.Dump.Memory
   , memory
   ) where
 
+import Control.Monad as Monad
+import Data.ByteString qualified as BS
 import Data.ElfEdit qualified as EE
 import Data.Macaw.Architecture.Info qualified as MAI
 import Data.Macaw.BinaryLoader qualified as Loader
@@ -16,12 +19,15 @@ import Data.Macaw.CFG.Core qualified as MC
 import Data.Macaw.Dump.CLIUtils qualified as MDCU
 import Data.Macaw.Memory.LoadCommon qualified as LC
 import Data.Macaw.Memory qualified as MM
-import Data.Word (Word64)
+import Data.Word (Word8, Word64)
+import Numeric (showHex)
 import Options.Applicative qualified as Opt
+import Prettyprinter qualified as PP
 
 data MemoryConfig
   = MemoryConfig
     { memLoadOffset :: Maybe Word64
+    , memPrintContents :: Bool
     , memBinPath :: FilePath
     }
 
@@ -35,15 +41,58 @@ loadOffsetOpt = Opt.option Opt.auto opts
     , Opt.showDefault
     ]
 
+printContentsOpt :: Opt.Parser Bool
+printContentsOpt = Opt.switch opts
+  where
+  opts =
+    mconcat
+    [ Opt.long "contents"
+    , Opt.help "print the contents of memory"
+    ]
+
 memoryConfig :: Opt.Parser MemoryConfig
 memoryConfig =
   MemoryConfig
   <$> Opt.optional loadOffsetOpt
+  <*> printContentsOpt
   <*> MDCU.binOpt
 
 loadOptions :: MemoryConfig -> LC.LoadOptions
 loadOptions cfg = LC.LoadOptions { LC.loadOffset = memLoadOffset cfg }
 
+ppChunk :: MM.MemChunk w -> PP.Doc ann
+ppChunk =
+  \case
+    MM.ByteRegion bs -> PP.fillSep (map ppByte (BS.unpack bs))
+    MM.RelocationRegion reloc -> PP.viaShow reloc
+    MM.BSSRegion size ->
+      PP.hcat
+      [ PP.pretty "[bss,"
+      , PP.pretty size
+      , PP.pretty ']'
+      ]
+  where
+    ppByte :: Word8 -> PP.Doc ann
+    ppByte w | w < 16    = PP.pretty '0' <> PP.pretty (showHex w "")
+             | otherwise = PP.pretty (showHex w "")
+
+ppMemContent ::
+  MM.MemWidth w =>
+  MM.Memory w ->
+  PP.Doc ann
+ppMemContent mem =
+  PP.vcat (map (uncurry printChunk) (MM.relativeSegmentContents (MM.memSegments mem)))
+  where
+  -- l = the max textual length of a MemAddr (assuming < 10 regions)
+  l = length "segmentN+0x0000000000000000"
+  padr s =
+    PP.hcat
+    [ PP.pretty s
+    , PP.pretty ": "
+    , PP.hcat (replicate (l - length s) PP.space)
+    ]
+  printChunk addr chunk = padr (show addr) PP.<> PP.align (ppChunk chunk)
+
 memory ::
   forall arch.
   ( MM.MemWidth (MC.ArchAddrWidth arch)
@@ -58,3 +107,6 @@ memory archInfo cfg = do
   loaded <- Loader.loadBinary @arch loadOpts ehi
   let mem = Loader.memoryImage loaded
   print mem
+  Monad.when (memPrintContents cfg) $ do
+    putStrLn "\nContents:"
+    print (ppMemContent mem)