From 6877c232b2b5d85433d5f441320e0bc01a84e495 Mon Sep 17 00:00:00 2001
From: plugd <plugd@thelambdalab.xyz>
Date: Sun, 29 Dec 2019 00:17:06 +1100
Subject: [PATCH] Added run-mars utility.

---
 Makefile     |  7 +++++++
 run-mars.scm | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+)
 create mode 100644 Makefile
 create mode 100644 run-mars.scm

diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..3297fa5
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,7 @@
+%.so : %.scm
+	csc -s $<
+
+run-mars: run-mars.scm mars.so parser.so visualizer.so
+	csc run-mars.scm
+
+all: run-mars
diff --git a/run-mars.scm b/run-mars.scm
new file mode 100644
index 0000000..63daf47
--- /dev/null
+++ b/run-mars.scm
@@ -0,0 +1,57 @@
+(import (chicken io)
+        (chicken process-context)
+        matchable
+        mars visualizer parser)
+
+(define (make-color-map progs colors)
+  (let loop ((entries '())
+             (progs-left progs)
+             (colors-left colors))
+    (if (null? progs-left)
+        entries
+        (let ((this-prog (car progs-left))
+              (this-col (car colors-left)))
+          (loop (cons (cons (prog-name this-prog) this-col) entries)
+                (cdr progs-left)
+                (cdr colors-left))))))
+
+(define (run-mars-with-vis files iters core-size)
+  (print "Iters: " iters ", core size: " core-size "\n")
+  (let* ((progs (map
+                 (lambda (fname)
+                   (string->prog (with-input-from-file fname read-string)))
+                 files))
+         (colors '("red" "blue" "green" "magenta" "cyan"))
+         (color-map (make-color-map progs colors))
+         (vis (make-vis 640 480 core-size color-map))
+         (core (make-core 8000 (make-instr 'DAT 'F 'immediate 0 'immediate 0)
+                          (lambda (i n)
+                            (vis 'update-owner i n))))
+         (queues (run-mars core (install-progs core progs) iters)))
+    (for-each (lambda (q)
+                (print "Final queue for " (queue-owner q) ":")
+                (dump-queue q core)
+                (print))
+              queues)
+    (print* "Press enter to finish...")
+    (read-line)))
+  
+
+(define (print-usage)
+  (print "Usage: run-mars [-h|--help]\n"
+         "       run-mars [-c|--core size] [-i|--iterations n] warrior1.red [warrior2.red [...]]"))
+
+(define (main)
+  (let loop ((args (cdr (argv)))
+             (iters 10000)
+             (core-size 8000))
+    (match args
+      ((or () ((or "-h" "--help")))
+       (print-usage))
+      (((or "-i" "--iterations") istr rest ...)
+       (loop rest (string->number istr) core-size))
+      (((or "-c" "--core-size") cstr rest ...)
+       (loop rest iters (string->number cstr)))
+      ((files ...)
+       (run-mars-with-vis files iters core-size)))))
+(main)
-- 
2.20.1