2 ;;; An implementation of the Memory Array Redcode Simulator (MARS)
12 (define core-size 8000)
13 (define max-steps 10000)
19 (define core (make-vector core-size '()))
25 (define (make-instr opcode modifier A-mode A-num B-mode B-num))
26 (define (instr-opcode instr) (list-ref instr 0))
27 (define (instr-modifier instr) (list-ref instr 1))
28 (define (instr-A-mode instr) (list-ref instr 2))
29 (define (instr-A-num instr) (list-ref instr 3))
30 (define (instr-B-mode instr) (list-ref instr 4))
31 (define (instr-B-num instr) (list-ref instr 5))
37 (define (make-player name . ptrs)
40 (define (player-ptrs player)
43 (define (player-name player)
46 (define (player-set-ptrs! player ptrs)
47 (set-cdr! player ptrs))
53 (define (run players step)
55 ((> step max-steps) players) ;Tie between remaining players
56 ((<= (length players) 1) players) ;There's only one player left who thus wins
58 (let ((player (car players))
59 (other-players (cdr players))
60 (ptrs (player-ptrs player)))
61 (let ((new-ptrs (execute-instr (car ptrs))))
63 (run other-players (+ step 1))
65 (player-set-ptrs! (append (cdr ptrs) new-ptrs))
66 (run (append other-players (list player)) (+ step 1)))))))))
68 (define (execute-instr ptr)
69 (let* ((instr (vector-ref core ptr))
70 (A-pointer (eval-operand (instr-A-mode instr) (instr-A-num) ptr))
71 (B-pointer (eval-operand (instr-B-mode instr) (instr-B-num) ptr)))
72 (case (instr-opcode instr)
89 (error "Unrecognised opcode" (instr-opcode instr))))))
91 (define (eval-operand mode num ptr)
95 ((indirect-A) (+ num (instr-A-num (vector-ref core (+ ptr num)))))
96 ((indirect-B) (+ num (instr-B-num (vector-ref core (+ ptr num)))))
98 (let ((aux-instr (vector-ref core (+ ptr num))))
99 (instr-set-A-num! aux-instr (- 1 (instr-A-num aux-instr)))
100 (+ num (instr-A-num aux-instr))))
102 (let ((aux-instr (vector-ref core (+ ptr num))))
103 (instr-set-B-num! aux-instr (- 1 (instr-B-num aux-instr)))
104 (+ num (instr-B-num aux-instr))))
106 (let* ((aux-instr (vector-ref core (+ ptr num)))
107 (old-A-num (instr-A-num aux-instr)))
108 (instr-set-A-num! aux-instr (+ 1 (instr-A-num aux-instr)))
111 (let* ((aux-instr (vector-ref core (+ ptr num)))
112 (old-B-num (instr-B-num aux-instr)))
113 (instr-set-B-num! aux-instr (+ 1 (instr-B-num aux-instr)))
116 (error "Unrecognized mode" mode))))