From: plugd <plugd@thelambdalab.xyz>
Date: Sat, 16 Nov 2019 12:15:41 +0000 (+0100)
Subject: Added conditional jump instructions.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=eee50b1eb67bb8f690c0925a7effad6dbc9d2217;p=jars.git

Added conditional jump instructions.
---

diff --git a/mars.scm b/mars.scm
index 39133d2..612f20a 100644
--- a/mars.scm
+++ b/mars.scm
@@ -205,8 +205,30 @@
          ((exn arithmetic) '())))
       ((JMP)
        (list (addr+ ptr ((core-get A-ptr) 'A-num))))
-      ((JMZ))
-      ((JMN))
+      ((JMZ)
+       (list (addr+ ptr
+                    (if (case modifier
+                          ((A BA)
+                           (= 0 ((core-get A-ptr) 'A-num)))
+                          ((B AB)
+                           (= 0 ((core-get A-ptr) 'B-num)))
+                          ((X I F)
+                           (and (= 0 ((core-get A-ptr) 'A-num))
+                                (= 0 ((core-get A-ptr) 'B-num)))))
+                        ((core-get A-ptr) 'A-num)
+                        1))))
+      ((JMN)
+       (list (addr+ ptr
+                    (if (not (case modifier
+                               ((A BA)
+                                (= 0 ((core-get A-ptr) 'A-num)))
+                               ((B AB)
+                                (= 0 ((core-get A-ptr) 'B-num)))
+                               ((X I F)
+                                (and (= 0 ((core-get A-ptr) 'A-num))
+                                     (= 0 ((core-get A-ptr) 'B-num))))))
+                        ((core-get A-ptr) 'A-num)
+                        1))))
       ((DJN))
       ((SEQ CMP))
       ((SNE))
@@ -244,21 +266,21 @@
            ((indirect-B) (addr+ num ((core-get (addr+ ptr num)) 'B-num)))
            ((pre-indirect-A)
             (let ((aux-instr (core-get (addr+ ptr num))))
-              (instr-set-A-num! aux-instr (addr+ -1 (aux-instr 'A-num)))
+              ((aux-instr set-A-num! (addr+ -1 (aux-instr 'A-num))))
               (addr+ num (aux-instr 'A-num))))
            ((pre-indirect-B)
             (let ((aux-instr (core-get (addr+ ptr num))))
-              (instr-set-B-num! aux-instr (addr+ -1 (aux-instr 'B-num)))
+              (aux-instr set-B-num!(addr+ -1 (aux-instr 'B-num)))
               (addr+ num (aux-instr 'B-num))))
            ((post-indirect-A)
             (let* ((aux-instr (core-get (addr+ ptr num)))
                    (old-A-num (aux-instr 'A-num)))
-              (instr-set-A-num! aux-instr (addr+ 1 (aux-instr 'A-num)))
+              (aux-instr set-A-num! (addr+ 1 (aux-instr 'A-num)))
               (addr+ num old-A-num)))
            ((post-indirect-B)
             (let* ((aux-instr (core-get (addr+ ptr num)))
                    (old-B-num (aux-instr 'B-num)))
-              (instr-set-B-num! aux-instr (addr+ 1 (aux-instr 'B-num)))
+              (aux-instr set-B-num! (addr+ 1 (aux-instr 'B-num)))
               (addr+ num old-B-num)))
            (else
             (error "Unrecognized mode" mode)))))