From: plugd <plugd@thelambdalab.xyz>
Date: Mon, 11 May 2020 15:48:09 +0000 (+0200)
Subject: Easier debugging of MARS.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=commitdiff_plain;h=7281b0c1eefce213d11cada1cb9f86a2d8fb0779;hp=3658516d8dd5cea71cac2a7637f5470b5b87b228

Easier debugging of MARS.
---

diff --git a/README b/README
index 7b62697..9c6f9cc 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ JaRS: Janky Redcode Simulator
 =============================
 
 A hobby implementation of the Memory Array Redcode Simulator (MARS)
-and associated tools for the programming game Corewar. The original
+and associated tools for the programming game, Core War. The original
 concept for this game was developed by A. K. Dewdney (see
 http://corewar.co.uk/dewdney for copies of the 1984 Scientific
 American columns where the idea was first presented).
@@ -14,6 +14,9 @@ At this pont, JaRS contains utilities for:
 - Maintaining King of the Hill style tournaments in the spirit of
   http://www.koth.org.
 
+JaRS is still under development, and many aspects have not been fully
+tested.  Use at your own risk!
+
 Further Details
 ---------------
 
diff --git a/mars.scm b/mars.scm
index 677d754..ae70c88 100644
--- a/mars.scm
+++ b/mars.scm
@@ -6,6 +6,7 @@
     (make-instr
      make-prog
      prog-name
+     prog-author
      prog-instrs
      prog-offset
      prog->string
@@ -212,20 +213,20 @@
   ;;; Executive function
   ;;
 
-  (define (run-mars core queues steps-left)
-    (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 (run-mars core queues steps-left . rest)
+    (let ((min-queue-count (if (null? rest) 2 (car rest))))
+      (if (or (<= steps-left 0)
+              (< (length queues) min-queue-count))
+          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 ")")