From 0cdd25d921202030745069dbccd16ef856e16750 Mon Sep 17 00:00:00 2001
From: Aleksey Veresov <aleksey@veresov.pro>
Date: Sun, 14 Feb 2021 21:01:33 +0300
Subject: Example commands added.

---
 src/Commands.hs | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)
 create mode 100644 src/Commands.hs

(limited to 'src/Commands.hs')

diff --git a/src/Commands.hs b/src/Commands.hs
new file mode 100644
index 0000000..1413c87
--- /dev/null
+++ b/src/Commands.hs
@@ -0,0 +1,30 @@
+module Commands where
+
+import Control.Lens
+import Machine
+
+doNothing :: Machine -> Machine
+doNothing m = Machine (Registers (pc r + 2) (sr r) (drs r)
+                                 (ars r) (usp r) (ssp r))
+                      (ram m) (rom m)
+    where r = regs m
+
+doUnlink :: Int -> Machine -> Machine
+doUnlink 7 m = let r = regs m in if isSupervisor m
+    then Machine (Registers (pc r + 2) (sr r) (drs r) (ars r)
+                            (usp r) (getLong m (fromIntegral $ ssp r) + 4))
+                 (ram m) (rom m)
+    else Machine (Registers (pc r + 2) (sr r) (drs r) (ars r)
+                            (getLong m (fromIntegral $ usp r) + 4) (ssp r))
+                 (ram m) (rom m)
+doUnlink a m = let
+        r = regs m
+        av = getLong m (fromIntegral (ars r !! a))
+        newars = ars r & element (fromIntegral a) .~ av
+    in if isSupervisor m
+    then Machine (Registers (pc r + 2) (sr r) (drs r)
+                            newars (usp r) (av + 4))
+                 (ram m) (rom m)
+    else Machine (Registers (pc r + 2) (sr r) (drs r)
+                            newars (av + 4) (ssp r))
+                 (ram m) (rom m)
-- 
cgit v1.2.3