From: plugd <plugd@thelambdalab.xyz>
Date: Thu, 19 Aug 2021 07:55:04 +0000 (+0200)
Subject: Added debugger.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=bebac0e359cb9ce7aa72aeb217dcc57301e26a51;p=jars.git

Added debugger.
---

diff --git a/.gitignore b/.gitignore
index 42eb7f0..4510f30 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,7 @@
 # Executables
 koth
 run-mars
+debug-mars
 
 # Libraries
 *.o
diff --git a/Makefile b/Makefile
index d0bc8af..e6aca14 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-all : koth run-mars
+all : koth run-mars debug-mars
 
 %.so : %.scm
 	csc -s $< -J
@@ -6,17 +6,19 @@ all : koth run-mars
 run-mars : run-mars.scm mars.so parser.so visualizer.so
 	csc run-mars.scm
 
+debug-mars : debug-mars.scm mars.so parser.so
+	csc debug-mars.scm
+
 koth : koth.scm mars.so parser.so
 	csc koth.scm
 
 clean :
 	rm -f koth run-mars *.so *.link *.import.scm *.o
 
-# Cross-compile static executable
 koth_linux:
-	csc_linux -static -c mars.scm -unit mars -J
-	csc_linux -static -c parser.scm -unit parser -J
-	csc_linux -static -L -static koth.scm -link mars,parser
+	csc_linux -c mars.scm -unit mars -J
+	csc_linux -c parser.scm -unit parser -J
+	csc_linux koth.scm -link mars,parser
 
 # csc_linux -c mars.scm -unit mars -uses matchable -J
 # csc_linux -c parser.scm -unit parser -uses srfi-13 -J
diff --git a/debug-mars.scm b/debug-mars.scm
new file mode 100644
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)
diff --git a/test.scm b/test.scm
deleted file mode 100644
index 178260d..0000000
--- a/test.scm
+++ /dev/null
@@ -1,67 +0,0 @@
-(import (chicken io)
-        mars visualizer parser)
-
-;; (define addressing-test
-;;   (make-prog 'at (list
-;;                   (make-instr 'DAT 'F 'immediate 42 'immediate 53)
-;;                   (make-instr 'DAT 'F 'immediate 123 'immediate 256)
-;;                   (make-instr 'MOV 'A 'indirect-B 4 'direct 7)
-;;                   (make-instr 'NOP 'I 'immediate 0 'immediate 0)
-;;                   (make-instr 'NOP 'I 'immediate 0 'immediate 0)
-;;                   (make-instr 'NOP 'I 'immediate 0 'immediate 0)
-;;                   (make-instr 'DAT 'F 'immediate -5 'immediate -6)) 2))
-
-;; (define imp
-;;   (make-prog 'imp (list (make-instr 'MOV 'I 'direct 0 'direct 1)) 0))
-
-;; (define dwarf
-;;   (make-prog 'dwarf (list
-;;                      (make-instr 'DAT 'F 'immediate 0 'immediate -1)
-;;                      (make-instr 'ADD 'AB 'immediate 5 'direct -1)
-;;                      (make-instr 'MOV 'I 'direct -2 'indirect-B -2)
-;;                      (make-instr 'JMP 'I 'immediate -2 'immediate 0)) 1))
-
-(condition-case
-    (vis 'destroy)
-  ((exn) #f))
-
-;; (define files '("dwarf.red"))
-(define files '("imp.red" "dwarf.red"))
-
-(define progs
-  (map
-   (lambda (fname)
-     (string->prog (with-input-from-file fname read-string)))
-   files))
-
-(define colors '("red" "blue" "green" "magenta" "cyan"))
-
-(define color-map
-  (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 vis (make-vis 640 480 8000 color-map))
-
-(define core (make-core 8000 (make-instr 'DAT 'F 'immediate 0 'immediate 0)
-                        (lambda (i n)
-                          (vis 'update-owner i n))))
-
-(define queues (install-progs core progs))
-
-(for-each dump-prog progs)
-
-(set! queues (run-mars core queues 10000))
-
-(for-each (lambda (q)
-            (print "Queue for " (queue-owner q) ":")
-            (dump-queue q core)
-            (print))
-          queues)