Easier debugging of MARS.

[jars.git] / mars.scm

diff --git a/mars.scm b/mars.scm
index 677d754..ae70c88 100644 (file)
--- 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 ")")