From bebac0e359cb9ce7aa72aeb217dcc57301e26a51 Mon Sep 17 00:00:00 2001 From: plugd Date: Thu, 19 Aug 2021 09:55:04 +0200 Subject: [PATCH] Added debugger. --- .gitignore | 1 + Makefile | 12 +++++---- debug-mars.scm | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++ test.scm | 67 ---------------------------------------------- 4 files changed, 80 insertions(+), 72 deletions(-) create mode 100644 debug-mars.scm delete mode 100644 test.scm 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) -- 2.20.1