run-mars.scm

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