From ef88eb173fc87bfe1b87be533e4f574209d40b1d Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Tue, 26 Feb 2019 11:05:22 +0100
Subject: Initial import

Disassembler seems to be working.
---
 src/Main.purs | 99 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)
 create mode 100644 src/Main.purs

(limited to 'src/Main.purs')

diff --git a/src/Main.purs b/src/Main.purs
new file mode 100644
index 0000000..4906542
--- /dev/null
+++ b/src/Main.purs
@@ -0,0 +1,99 @@
+module Main (main, fileToArrayView) where
+
+import Prelude
+import Effect (Effect, foreachE)
+import Effect.Console (log)
+import Data.List
+import Data.List as L
+import Data.Tuple
+import Data.Int
+import Data.String.Utils (length, repeat)
+import Data.Maybe (fromJust, Maybe(..), maybe)
+import Partial.Unsafe (unsafePartial)
+import Node.FS.Sync (readFile)
+import Node.Buffer (toArrayBuffer)
+import Data.ArrayBuffer.Typed (whole, toArray, (!))
+import Data.ArrayBuffer.Types (Uint16, ArrayView)
+import Data.UInt (toInt)
+import Data.Either (either)
+import Control.Monad.Rec.Class
+import Node.Process (argv)
+import Data.Array ((!!))
+
+import Decode
+import Asm
+import InstructionSet
+import Machine
+
+-- | Left-pad a string `s` to at least `num` characters with `pad`
+lpad :: Int -> String -> String -> String
+lpad num pad s = prefix <> s
+	where
+		prefix = case repeat (num-(length s)) pad of
+			Just x -> x
+			Nothing -> ""
+
+-- | Right-pad a string `s` to at least `num` characters with `pad`
+rpad :: Int -> String -> String -> String
+rpad num pad s = s <> prefix
+	where
+		prefix = case repeat (num-(length s)) pad of
+			Just x -> x
+			Nothing -> ""
+
+-- | Hex-format number `v`, adding padding to at least `len` characters
+toHex :: Int -> Int -> String
+toHex len v = lpad len "0" $ toStringAs hexadecimal v
+
+hexdump :: List Int -> String
+hexdump words = intercalate " " $ map (toHex 4) words
+
+-- Format instruction with hexdump @width
+formatInst :: Int -> Int -> Tuple (List Int) Instruction -> String
+formatInst address width (Tuple words inst) = toHex 8 address <> " | " <> rpad width " " (hexdump words) <> " | " <> (rpad 10 " " mnemonic) <> "  " <> (intercalate ", " args)
+	where
+		asmInst = toAsm inst
+		mnemonic = unsafePartial $ fromJust $ head asmInst
+		args = unsafePartial $ fromJust $ tail asmInst
+
+-- | Create ArrayView from a file `name`.
+fileToArrayView :: String -> Effect (ArrayView Uint16)
+fileToArrayView name = (readFile name) >>= toArrayBuffer >>= whole
+
+logInst address = (log <<< (formatInst address (hexWords*hexWordWidth+hexWords*spaceWidth)))
+	where
+		hexWordWidth = 4
+		hexWords = maxInstructionLen
+		spaceWidth = 1
+
+-- Take n words from an ArrayView starting at offset
+takeView :: Int -> Int -> ArrayView Uint16 -> Effect (List Int)
+takeView _ 0 _ = pure Nil
+takeView offset n view = (view ! offset) >>= maybe (pure Nil) recurse
+	where
+		recurse v = ((:) (toInt v)) <$> (takeView (offset+1) (n-1) view)
+
+-- Disassemble memory in @view starting at @startAddress
+disasm :: Int -> ArrayView Uint16 -> Effect Unit
+disasm startAddress view = tailRecM go startAddress
+	where
+		go address = do
+			words <- takeView address maxInstructionLen view
+			either invalid (continue address words) $ decode words
+		invalid (InputTooShort x) = do
+			log $ "input too short " <> show x
+			pure $ Done unit
+		invalid (UnknownOpcode x) = do
+			log $ "unknown opcode " <> show x
+			pure $ Done unit
+		continue address words (Tuple inst len) = do
+			logInst (address*wordsize) (Tuple (take len words) inst)
+			pure $ Loop(address+len)
+			
+main :: Effect Unit
+main = secondArg >>= (maybe argumentMissing doDisasm)
+	where
+		secondArg = (flip (!!) $ 2) <$> argv
+		argumentMissing = log "Missing argument"
+		doDisasm file = fileToArrayView file >>= disasm codeOffset
+
-- 
cgit v1.2.3