From 7281b0c1eefce213d11cada1cb9f86a2d8fb0779 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 11 May 2020 17:48:09 +0200 Subject: [PATCH] Easier debugging of MARS. --- README | 5 ++++- mars.scm | 29 +++++++++++++++-------------- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/README b/README index 7b62697..9c6f9cc 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ JaRS: Janky Redcode Simulator ============================= A hobby implementation of the Memory Array Redcode Simulator (MARS) -and associated tools for the programming game Corewar. The original +and associated tools for the programming game, Core War. The original concept for this game was developed by A. K. Dewdney (see http://corewar.co.uk/dewdney for copies of the 1984 Scientific American columns where the idea was first presented). @@ -14,6 +14,9 @@ At this pont, JaRS contains utilities for: - Maintaining King of the Hill style tournaments in the spirit of http://www.koth.org. +JaRS is still under development, and many aspects have not been fully +tested. Use at your own risk! + Further Details --------------- diff --git a/mars.scm b/mars.scm index 677d754..ae70c88 100644 --- a/mars.scm +++ b/mars.scm @@ -6,6 +6,7 @@ (make-instr make-prog prog-name + prog-author prog-instrs prog-offset prog->string @@ -212,20 +213,20 @@ ;;; Executive function ;; - (define (run-mars core queues steps-left) - (if (or (<= steps-left 0) - (null? queues) - (= (length queues) 1)) - queues - (let* ((queue (car queues)) - (remaining-queues (cdr queues)) - (ptrs (queue-ptrs queue)) - (new-ptrs (execute-instr core (car ptrs) (queue-owner queue)))) - (if (null? new-ptrs) - (run-mars core remaining-queues (- steps-left 1)) - (begin - (queue-set-ptrs! queue (append (cdr ptrs) new-ptrs)) - (run-mars core (append remaining-queues (list queue)) (- steps-left 1))))))) + (define (run-mars core queues steps-left . rest) + (let ((min-queue-count (if (null? rest) 2 (car rest)))) + (if (or (<= steps-left 0) + (< (length queues) min-queue-count)) + queues + (let* ((queue (car queues)) + (remaining-queues (cdr queues)) + (ptrs (queue-ptrs queue)) + (new-ptrs (execute-instr core (car ptrs) (queue-owner queue)))) + (if (null? new-ptrs) + (run-mars core remaining-queues (- steps-left 1)) + (begin + (queue-set-ptrs! queue (append (cdr ptrs) new-ptrs)) + (run-mars core (append remaining-queues (list queue)) (- steps-left 1)))))))) (define (execute-instr core ptr name) ;; (print ptr "\t" (core ptr '->string) "\t(" name ")") -- 2.20.1