c77e2d3142f9338b0a90715aa749af07858ab316
[jars.git] / 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