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         (if (null? colors-left)
  16             (error "Not enough colours in colour map!")
  17             (let ((this-prog (car progs-left))
  18                   (this-col (car colors-left)))
  19               (loop (cons (cons (prog-name this-prog) this-col) entries)
  20                     (cdr progs-left)
  21                     (cdr colors-left)))))))
  22
  23 (define (mars-runner files iters core-size visualization min-queue-count)
  24   (print "Iters: " iters ", core size: " core-size)
  25   (let* ((progs (map
  26                  (lambda (fname)
  27                    (string->prog (with-input-from-file fname read-string)))
  28                  files))
  29          (core (if visualization
  30                    (let* ((colors '("red" "blue" "green" "magenta" "cyan"))
  31                           (color-map (make-color-map progs colors))
  32                           (vis (make-vis 640 480 core-size color-map)))
  33                      (make-core core-size (lambda (i n)
  34                                             (vis 'update-owner i n))))
  35                    (make-core core-size)))
  36          (queues (run-mars core (install-progs core progs) iters min-queue-count)))
  37     (dump-queues queues core)
  38     (when visualization
  39       (print* "Press enter to finish...")
  40       (read-line))))
  41
  42 (define (print-usage)
  43   (print "Usage: run-mars [-h|--help]\n"
  44          "       run-mars [-c|--core size]\n"
  45          "                [-i|--iterations iters]\n"
  46          "                [-v|--visualization]\n"
  47          "                [-m|--min-queue-count]\n"
  48          "                warrior1.red [warrior2.red [...]]"))
  49
  50 (define (main)
  51   (let loop ((args (cdr (argv)))
  52              (iters 10000)
  53              (core-size 8000)
  54              (visualization #f)
  55              (min-queue-count 2))
  56     (match args
  57       ((or () ((or "-h" "--help")))
  58        (print-usage))
  59       (((or "-i" "--iterations") istr rest ...)
  60        (loop rest (string->number istr) core-size visualization min-queue-count))
  61       (((or "-c" "--core-size") cstr rest ...)
  62        (loop rest iters (string->number cstr) visualization min-queue-count))
  63       (((or "-v" "--visualization") rest ...)
  64        (loop rest iters core-size #t min-queue-count))
  65       (((or "-m" "--min-queue-count") mstr rest ...)
  66        (loop rest iters core-size visualization (string->number mstr)))
  67       ((files ...)
  68        (mars-runner files iters core-size visualization min-queue-count)))))
  69
  70 (main)