run-mars.scm

   1 (import (chicken io)
   2         (chicken process-context)
   3         matchable
   4         mars visualizer parser)
   5
   6 (define (make-color-map progs colors)
   7   (let loop ((entries '())
   8              (progs-left progs)
   9              (colors-left colors))
  10     (if (null? progs-left)
  11         entries
  12         (let ((this-prog (car progs-left))
  13               (this-col (car colors-left)))
  14           (loop (cons (cons (prog-name this-prog) this-col) entries)
  15                 (cdr progs-left)
  16                 (cdr colors-left))))))
  17
  18 (define (run-mars-with-vis files iters core-size)
  19   (print "Iters: " iters ", core size: " core-size "\n")
  20   (let* ((progs (map
  21                  (lambda (fname)
  22                    (string->prog (with-input-from-file fname read-string)))
  23                  files))
  24          (colors '("red" "blue" "green" "magenta" "cyan"))
  25          (color-map (make-color-map progs colors))
  26          (vis (make-vis 640 480 core-size color-map))
  27          (core (make-core 8000 (make-instr 'DAT 'F 'immediate 0 'immediate 0)
  28                           (lambda (i n)
  29                             (vis 'update-owner i n))))
  30          (queues (run-mars core (install-progs core progs) iters)))
  31     (for-each (lambda (q)
  32                 (print "Final queue for " (queue-owner q) ":")
  33                 (dump-queue q core)
  34                 (print))
  35               queues)
  36     (print* "Press enter to finish...")
  37     (read-line)))
  38
  39
  40 (define (print-usage)
  41   (print "Usage: run-mars [-h|--help]\n"
  42          "       run-mars [-c|--core size] [-i|--iterations n] warrior1.red [warrior2.red [...]]"))
  43
  44 (define (main)
  45   (let loop ((args (cdr (argv)))
  46              (iters 10000)
  47              (core-size 8000))
  48     (match args
  49       ((or () ((or "-h" "--help")))
  50        (print-usage))
  51       (((or "-i" "--iterations") istr rest ...)
  52        (loop rest (string->number istr) core-size))
  53       (((or "-c" "--core-size") cstr rest ...)
  54        (loop rest iters (string->number cstr)))
  55       ((files ...)
  56        (run-mars-with-vis files iters core-size)))))
  57 (main)