mars.scm

   1 ;;;
   2 ;;; An implementation of the Memory Array Redcode Simulator (MARS)
   3 ;;;
   4
   5 ;;; Constants
   6 ;;
   7
   8 (define core-size 8000)
   9 (define max-steps 10000)
  10
  11
  12 ;;; Memory setup
  13 ;;
  14
  15 (define core (make-vector core-size '()))
  16
  17
  18 ;;; Instructions
  19 ;;
  20
  21 (define (make-instr opcode modifier addrA modeA addrB modeB))
  22
  23
  24 ;;; Players
  25 ;;
  26
  27 (define (make-player name . ptrs)
  28   (cons name ptrs))
  29
  30 (define (player-ptrs player)
  31   (cdr player))
  32
  33 (define (player-name player)
  34   (car player))
  35
  36 (define (player-set-ptrs! player ptrs)
  37   (set-cdr! player ptrs))
  38
  39
  40 ;;; Main loop
  41 ;;
  42
  43 (define (list-rot l)
  44   (if (> (length l) 1)
  45       (append (cdr l) (list (car l)))
  46       l))
  47
  48 (define (run playerA playerB step)
  49   (cond
  50    ((> step max-steps) 'tie)
  51    ((null? (player-ptrs playerA) playerB))
  52    ((null? (player-ptrs playerB) playerA))
  53    (else
  54     (let ((ptrs (player-ptrs playerA)))
  55       (player-set-ptrs! (append (cdr ptrs)
  56                                 (execute-instr (car ptrs)))))
  57     (run playerB player A (+ step 1)))))
  58
  59 (define (execute-instr ptr)
  60   (let ((instr (vector-ref core ptr)))
  61     (match instr
  62       ())))
  63