From 3a114d7766919b3a26fad4b228c60f34f6f46c20 Mon Sep 17 00:00:00 2001
From: tzlil <tzlils@protonmail.com>
Date: Tue, 31 Oct 2023 12:44:26 +0200
Subject: initial commit

---
 Simulator.hs | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100644 Simulator.hs

(limited to 'Simulator.hs')

diff --git a/Simulator.hs b/Simulator.hs
new file mode 100644
index 0000000..1718b60
--- /dev/null
+++ b/Simulator.hs
@@ -0,0 +1,79 @@
+module Main where
+
+import qualified Data.Sequence as S
+import Control.Monad.State
+import Data.Word ( Word16 )
+import Data.Maybe (isNothing)
+import Data.Bits ( Bits((.&.), complement, shiftR) )
+import Data.Sequence ((!?))
+import Debug.Trace
+
+
+data Machine = Machine {
+    pc :: Int,
+    registers :: S.Seq Int,
+    memory :: S.Seq Int
+} deriving Show
+
+mkMachine :: [String] -> Machine
+mkMachine f = Machine 0 (S.replicate 8 0) (S.fromList $ map read f)
+
+data MachineError = Halt | MemoryAccessError deriving (Show,Eq)
+execute :: State Machine (Maybe MachineError)
+execute = do
+    inst <- gets (S.lookup.pc<*>memory)
+    -- increment pc
+    -- modify $ Machine.((+1).pc)<*>memory<*>registers
+    regs <- gets registers
+    mem <- gets memory
+    pc <- gets $ (+1).pc
+    case inst of
+        Nothing -> return $ Just MemoryAccessError
+        Just inst ->
+            let Just regA = S.lookup (inst `shiftR` 19 .&. 0b111) regs
+                Just regB = S.lookup (inst `shiftR` 16 .&. 0b111) regs
+                destReg = inst .&. 0b111
+                offsetField = inst .&. 0b1111111111111111
+                wrapAdd x y = (fromIntegral (fromIntegral (x+y) :: Word16) :: Int)
+                 in case inst `shiftR` 22 .&. 0b111 of
+                -- ADD
+                0 -> do
+                    put $ Machine pc (S.update destReg (regA+regB) regs) mem
+                    return Nothing
+                -- NAND
+                1 -> do
+                    put $ Machine pc (S.update destReg (complement regA.&.regB) regs) mem
+                    return Nothing
+                -- LW
+                2 -> do
+                    case S.lookup (wrapAdd offsetField regA) mem of
+                        Nothing -> return $ Just MemoryAccessError
+                        Just v -> do
+                            put $ Machine pc (S.update (inst `shiftR` 16 .&. 0b11) v regs) mem
+                            return Nothing
+                -- SW
+                3 -> do
+                    put $ Machine pc regs (S.update (wrapAdd offsetField regA) regB mem)
+                    return Nothing
+                --- BEQ
+                4 -> do
+                    if regA==regB then 
+                        put $ Machine (wrapAdd offsetField pc)  regs mem
+                    else put $ Machine pc regs mem
+                    return Nothing
+                -- XXX
+                5 -> return Nothing
+                -- HALT
+                6 -> return $ Just Halt
+                -- NOOP
+                7 -> return Nothing
+
+
+main :: IO ()
+main = do
+    input <- getContents
+    let m = until ((/=Nothing).evalState execute) (execState execute) $ mkMachine (lines input)
+    case evalState execute m of
+        Just Halt -> putStrLn "Machine halted"
+        Just MemoryAccessError -> putStrLn "Out of bounds memory access"
+    print m
\ No newline at end of file
-- 
cgit 1.4.1