X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=blobdiff_plain;f=mars.scm;h=3ead51f09ec9b19da85ae4bbba8bf6677590a72d;hp=9610d10c791c47f08480589e484a1c285759f899;hb=fc74ea10adf5074f3464e08552a5fbd540c0243d;hpb=7526b1f66f4c7a0d460d0e267b1eb4553c0d981b

diff --git a/mars.scm b/mars.scm
index 9610d10..3ead51f 100644
--- a/mars.scm
+++ b/mars.scm
@@ -205,24 +205,25 @@
 
   (define (dump-prog prog)
     (print (prog->string prog)))
-    
+
+
   ;;; Executive function
   ;;
 
   (define (run-mars core queues steps-left)
-    (cond
-     ((<= steps-left 0) queues)      ;Tie between remaining players
-     ((null? queues) queues)         ;Everyone's dead
-     (else
-      (let* ((queue (car queues))
-             (remaining-queues (cdr queues))
-             (ptrs (queue-ptrs queue))
-             (new-ptrs (execute-instr core (car ptrs) (queue-owner queue))))
-        (if (null? new-ptrs)
-            (run-mars core remaining-queues (- steps-left 1))
-            (begin
-              (queue-set-ptrs! queue (append (cdr ptrs) new-ptrs))
-              (run-mars core (append remaining-queues (list queue)) (- steps-left 1))))))))
+    (if (or (<= steps-left 0)
+            (null? queues)
+            (= (length queues) 1))
+        queues
+        (let* ((queue (car queues))
+               (remaining-queues (cdr queues))
+               (ptrs (queue-ptrs queue))
+               (new-ptrs (execute-instr core (car ptrs) (queue-owner queue))))
+          (if (null? new-ptrs)
+              (run-mars core remaining-queues (- steps-left 1))
+              (begin
+                (queue-set-ptrs! queue (append (cdr ptrs) new-ptrs))
+                (run-mars core (append remaining-queues (list queue)) (- steps-left 1)))))))
 
   (define (execute-instr core ptr name)
     ;; (print ptr "\t" (core ptr '->string) "\t(" name ")")
@@ -262,15 +263,15 @@
         ((JMP)
          (list (core '->addr A-ptr)))
         ((JMZ)
-         (list (core '->addr (if (instr-zero? B-ptr modifier #f name)
+         (list (core '->addr (if (instr-zero? core B-ptr modifier #f name)
                                  A-ptr
                                  (+ ptr 1)))))
         ((JMN)
-         (list (core '->addr (if (not (instr-zero? B-ptr modifier #f name))
+         (list (core '->addr (if (not (instr-zero? core B-ptr modifier #f name))
                                  A-ptr
                                  (+ ptr 1)))))
         ((DJN)
-         (list (core '->addr (if (not (instr-zero? B-ptr modifier #t name))
+         (list (core '->addr (if (not (instr-zero? core B-ptr modifier #t name))
                                  A-ptr
                                  (+ ptr 1)))))
         ((SEQ CMP)