Added debugger.

[jars.git] / debug-mars.scm

diff --git a/debug-mars.scm b/debug-mars.scm
new file mode 100644 (file)
index 0000000..6f730a2
--- /dev/null
+++ b/debug-mars.scm
@@ -0,0 +1,72 @@
+(import (chicken io)
+        (chicken pathname)
+        (chicken process-context)
+        matchable
+        srfi-13
+        mars parser)
+
+(define (load-progs filenames)
+  (map (lambda (filename)
+         (string->prog (with-input-from-file filename read-string)))
+       filenames))
+
+(define (print-help)
+  (print "Commands:\n"
+         "q:\tPrint current process queues\n"
+         "c:\tClear and reinitialize core\n"
+         "d:\tDump list of instructions around each process instruction pointer\n"
+         "s, n:\tStep to next iteration\n"
+         "x:\tQuit debugger"))
+
+(define (mars-debugger core-size filenames)
+  (let* ((core (make-core core-size))
+         (progs (load-progs filenames))
+         (queues (install-progs core progs)))
+    (print "JaRS Redcode Debugger. Enter 'h' for help.")
+    (let loop ()
+      (print* "> ")
+      (if
+       (match (string-tokenize (read-line))
+         (("h")
+          (print-help)
+          #t)
+         (("q")
+          (print queues)
+          #t)
+         (("c")
+          (print "Reinitializing...")
+          (set! core (make-core core-size))
+          (set! queues (install-progs core progs))
+          #t)
+         (("d")
+          (dump-queues queues core)
+          #t)
+         ((or ("s") ("n") ())
+          (set! queues (run-mars core queues 1 1))
+          (dump-queues queues core)
+          #t)
+         (("x")
+          #f)
+         (other
+          (print "Error: unrecognised command '" other "'")
+          #t))
+       (loop)
+       (print "Bye.")))))
+
+(define (print-usage)
+  (print "Usage: run-mars [-h|--help]\n"
+         "       run-mars [-c|--core size]\n"
+         "                warrior1.red [warrior2.red [...]]"))
+
+(define (main)
+  (let loop ((args (cdr (argv)))
+             (core-size 8000))
+    (match args
+      ((or () ((or "-h" "--help")))
+       (print-usage))
+      (((or "-c" "--core-size") cstr rest ...)
+       (loop rest (string->number cstr)))
+      ((filenames ...)
+       (mars-debugger core-size filenames)))))
+
+(main)