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)
  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 8000 (lambda (i n)
  34                                        (vis 'update-owner i n))))
  35                    (make-core 8000)))
  36          (queues (run-mars core (install-progs core progs) iters)))
  37     (for-each (lambda (q)
  38                 (print)
  39                 (print "Final queue for " (queue-owner q) ":")
  40                 (dump-queue q core))
  41               queues)
  42     (when visualization
  43       (print* "Press enter to finish...")
  44       (read-line))))
  45
  46 (define (print-usage)
  47   (print "Usage: run-mars [-h|--help]\n"
  48          "       run-mars [-c|--core size]\n"
  49          "                [-i|--iterations iters]\n"
  50          "                [-n|--no-visualization]\n"
  51          "                warrior1.red [warrior2.red [...]]"))
  52
  53 (define (main)
  54   (let loop ((args (cdr (argv)))
  55              (iters 10000)
  56              (core-size 8000)
  57              (visualization #t))
  58     (match args
  59       ((or () ((or "-h" "--help")))
  60        (print-usage))
  61       (((or "-i" "--iterations") istr rest ...)
  62        (loop rest (string->number istr) core-size visualization))
  63       (((or "-c" "--core-size") cstr rest ...)
  64        (loop rest iters (string->number cstr) visualization))
  65       (((or "-n" "--no-visualization") rest ...)
  66        (loop rest iters core-size #f))
  67       ((files ...)
  68        (mars-runner files iters core-size visualization)))))
  69
  70 (main)