mars.scm

   1 ;;;
   2 ;;; An implementation of the Memory Array Redcode Simulator (MARS)
   3 ;;;
   4
   5 (import (chicken io)
   6         (chicken string)
   7         matchable)
   8
   9 ;;; Constants
  10 ;;
  11
  12 (define core-size 8000)
  13 (define max-steps 10000)
  14
  15
  16 ;;; Memory setup
  17 ;;
  18
  19 (define core (make-vector core-size '()))
  20
  21
  22 ;;; Instructions
  23 ;;
  24
  25 (define (make-instr opcode modifier addrA modeA addrB modeB))
  26
  27
  28 ;;; Players
  29 ;;
  30
  31 (define (make-player name . ptrs)
  32   (cons name ptrs))
  33
  34 (define (player-ptrs player)
  35   (cdr player))
  36
  37 (define (player-name player)
  38   (car player))
  39
  40 (define (player-set-ptrs! player ptrs)
  41   (set-cdr! player ptrs))
  42
  43
  44 ;;; Main loop
  45 ;;
  46
  47 (define (run players step)
  48   (cond
  49    ((> step max-steps) players) ;Tie between remaining players
  50    ((null? players) '())        ;Somehow we have no players remaining
  51    (else
  52     (let ((player (car players))
  53           (other-players (cdr players)))
  54       (if (null? ptrs)
  55           (run other-players (+ step 1))  ;Player is out
  56           (let* ((ptrs (player-ptrs player))
  57                  (new-ptrs (execute-instr (car ptrs))))
  58             (player-set-ptrs! (append (cdr ptrs) new-ptrs))
  59             (run (append other-players (list player)) (+ step 1))))))))
  60
  61 (define (execute-instr ptr)
  62   (let ((instr (vector-ref core ptr)))
  63     (case (instr-opcode instr)
  64       ((DAT))
  65       ((MOV))
  66       ((ADD))
  67       ((SUB))
  68       ((MUL))
  69       ((DIV))
  70       ((MOD))
  71       ((JMP))
  72       ((JMN))
  73       ((DJN))
  74       ((SEQ CMP))
  75       ((SNE))
  76       ((SLT))
  77       ((SPL))
  78       ((NOP))
  79       (else
  80        (error "Unrecognised opcode" (instr-opcode instr))))))
  81