Added conditional jump instructions.
authorplugd <plugd@thelambdalab.xyz>
Sat, 16 Nov 2019 12:15:41 +0000 (13:15 +0100)
committerplugd <plugd@thelambdalab.xyz>
Sat, 16 Nov 2019 12:15:41 +0000 (13:15 +0100)
mars.scm

index 39133d2..612f20a 100644 (file)
--- a/mars.scm
+++ b/mars.scm
          ((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))
            ((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)))))