debug-mars.scm

   1 (import (chicken io)
   2         (chicken pathname)
   3         (chicken process-context)
   4         matchable
   5         srfi-13
   6         mars parser)
   7
   8 (define (load-progs filenames)
   9   (map (lambda (filename)
  10          (string->prog (with-input-from-file filename read-string)))
  11        filenames))
  12
  13 (define (print-help)
  14   (print "Commands:\n"
  15          "q:\tPrint current process queues\n"
  16          "c:\tClear and reinitialize core\n"
  17          "d:\tDump list of instructions around each process instruction pointer\n"
  18          "s, n:\tStep to next iteration\n"
  19          "x:\tQuit debugger"))
  20
  21 (define (mars-debugger core-size filenames)
  22   (let* ((core (make-core core-size))
  23          (progs (load-progs filenames))
  24          (queues (install-progs core progs)))
  25     (print "JaRS Redcode Debugger. Enter 'h' for help.")
  26     (let loop ()
  27       (print* "> ")
  28       (if
  29        (match (string-tokenize (read-line))
  30          (("h")
  31           (print-help)
  32           #t)
  33          (("q")
  34           (print queues)
  35           #t)
  36          (("c")
  37           (print "Reinitializing...")
  38           (set! core (make-core core-size))
  39           (set! queues (install-progs core progs))
  40           #t)
  41          (("d")
  42           (dump-queues queues core)
  43           #t)
  44          ((or ("s") ("n") ())
  45           (set! queues (run-mars core queues 1 1))
  46           (dump-queues queues core)
  47           #t)
  48          (("x")
  49           #f)
  50          (other
  51           (print "Error: unrecognised command '" other "'")
  52           #t))
  53        (loop)
  54        (print "Bye.")))))
  55
  56 (define (print-usage)
  57   (print "Usage: run-mars [-h|--help]\n"
  58          "       run-mars [-c|--core size]\n"
  59          "                warrior1.red [warrior2.red [...]]"))
  60
  61 (define (main)
  62   (let loop ((args (cdr (argv)))
  63              (core-size 8000))
  64     (match args
  65       ((or () ((or "-h" "--help")))
  66        (print-usage))
  67       (((or "-c" "--core-size") cstr rest ...)
  68        (loop rest (string->number cstr)))
  69       ((filenames ...)
  70        (mars-debugger core-size filenames)))))
  71
  72 (main)