From: plugd Date: Thu, 14 Nov 2019 09:05:27 +0000 (+0100) Subject: Fleshing out executive function. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=commitdiff_plain;h=8c9a5e7af566f647f2acb58dabe558008964f27f Fleshing out executive function. --- diff --git a/mars.scm b/mars.scm index 57e3e13..c77e2d3 100644 --- a/mars.scm +++ b/mars.scm @@ -2,6 +2,10 @@ ;;; An implementation of the Memory Array Redcode Simulator (MARS) ;;; +(import (chicken io) + (chicken string) + matchable) + ;;; Constants ;; @@ -40,24 +44,38 @@ ;;; 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))))))