;;; An implementation of the Memory Array Redcode Simulator (MARS)
;;;
+(import (chicken io)
+ (chicken string)
+ matchable)
+
;;; Constants
;;
;;; Main loop
;;
-(define (list-rot l)
- (if (> (length l) 1)
- (append (cdr l) (list (car l)))
- l))
-
-(define (run playerA playerB step)
+(define (run players step)
(cond
- ((> step max-steps) 'tie)
- ((null? (player-ptrs playerA) playerB))
- ((null? (player-ptrs playerB) playerA))
+ ((> step max-steps) players) ;Tie between remaining players
+ ((null? players) '()) ;Somehow we have no players remaining
(else
- (let ((ptrs (player-ptrs playerA)))
- (player-set-ptrs! (append (cdr ptrs)
- (execute-instr (car ptrs)))))
- (run playerB player A (+ step 1)))))
+ (let ((player (car players))
+ (other-players (cdr players)))
+ (if (null? ptrs)
+ (run other-players (+ step 1)) ;Player is out
+ (let* ((ptrs (player-ptrs player))
+ (new-ptrs (execute-instr (car ptrs))))
+ (player-set-ptrs! (append (cdr ptrs) new-ptrs))
+ (run (append other-players (list player)) (+ step 1))))))))
(define (execute-instr ptr)
(let ((instr (vector-ref core ptr)))
- (match instr
- ())))
+ (case (instr-opcode instr)
+ ((DAT))
+ ((MOV))
+ ((ADD))
+ ((SUB))
+ ((MUL))
+ ((DIV))
+ ((MOD))
+ ((JMP))
+ ((JMN))
+ ((DJN))
+ ((SEQ CMP))
+ ((SNE))
+ ((SLT))
+ ((SPL))
+ ((NOP))
+ (else
+ (error "Unrecognised opcode" (instr-opcode instr))))))