From 4ccb7fe4e20053cd189864142aeb3d1d6c59c118 Mon Sep 17 00:00:00 2001 From: plugd Date: Thu, 29 Jul 2021 17:46:04 +0200 Subject: [PATCH] Final queue count now adjustable. --- koth.scm | 2 +- mars.scm | 54 ++++++++++++++++++++++++++++------------------------ run-mars.scm | 30 ++++++++++++++--------------- 3 files changed, 45 insertions(+), 41 deletions(-) diff --git a/koth.scm b/koth.scm index d25dcd1..db68efa 100644 --- a/koth.scm +++ b/koth.scm @@ -48,7 +48,7 @@ (define (score-game spec prog1 prog2) (let* ((core (make-core (spec-core-size spec))) (queues (install-progs core (list prog1 prog2))) - (result (run-mars core queues (spec-game-length spec)))) + (result (run-mars core queues (spec-game-length spec) 2))) (cond ((null? result) (error "Invalid game result.")) ((= (length result) 1) diff --git a/mars.scm b/mars.scm index ae70c88..d2d73e3 100644 --- a/mars.scm +++ b/mars.scm @@ -15,7 +15,7 @@ make-queue queue-owner queue-ptrs - dump-queue + dump-queues make-core run-mars) @@ -125,9 +125,7 @@ (norm-set! names-vec i n) (run-set-functions i n)) ((i 'name) (norm-ref names-vec i)) - (((? integer? i) v) ((norm-ref core-vec i) v)) - (('->addr (? integer? i)) (norm-addr i)) - (('dump i) + ((i 'dump) (let ((i1 (- i 4)) (i2 (+ i 4))) (let loop ((idx i1)) @@ -136,7 +134,10 @@ (print* "*")) (dump idx) (loop (+ idx 1)))))) - (('size) core-size))))) + (('size) core-size) + (((? integer? i) v) ((norm-ref core-vec i) v)) + (('->addr (? integer? i)) (norm-addr i)))))) + ;;; Programmes and task queues @@ -190,12 +191,15 @@ (define (queue-set-ptrs! queue ptrs) (set-cdr! queue ptrs)) - (define (dump-queue queue core) - (let loop ((ptrs (queue-ptrs queue))) - (unless (null? ptrs) - (core 'dump (car ptrs)) - (print) - (loop (cdr ptrs))))) + (define (dump-queues queues core) + (for-each (lambda (queue) + (print ";" (queue-owner queue)) + (for-each (lambda (ptr) + (core ptr 'dump) + (print)) + (cdr queue)) + (print)) + queues)) (define (prog->string prog) (conc ";redcode\n\n" @@ -213,20 +217,20 @@ ;;; Executive function ;; - (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 (run-mars core queues steps-left min-queue-count) + (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) min-queue-count) + (begin + (queue-set-ptrs! queue (append (cdr ptrs) new-ptrs)) + (run-mars core (append remaining-queues (list queue)) + (- steps-left 1) min-queue-count)))))) (define (execute-instr core ptr name) ;; (print ptr "\t" (core ptr '->string) "\t(" name ")") diff --git a/run-mars.scm b/run-mars.scm index 30b9e5c..04aa81e 100644 --- a/run-mars.scm +++ b/run-mars.scm @@ -20,7 +20,7 @@ (cdr progs-left) (cdr colors-left))))))) -(define (mars-runner files iters core-size visualization) +(define (mars-runner files iters core-size visualization min-queue-count) (print "Iters: " iters ", core size: " core-size) (let* ((progs (map (lambda (fname) @@ -30,15 +30,11 @@ (let* ((colors '("red" "blue" "green" "magenta" "cyan")) (color-map (make-color-map progs colors)) (vis (make-vis 640 480 core-size color-map))) - (make-core 8000 (lambda (i n) - (vis 'update-owner i n)))) - (make-core 8000))) - (queues (run-mars core (install-progs core progs) iters))) - (for-each (lambda (q) - (print) - (print "Final queue for " (queue-owner q) ":") - (dump-queue q core)) - queues) + (make-core core-size (lambda (i n) + (vis 'update-owner i n)))) + (make-core core-size))) + (queues (run-mars core (install-progs core progs) iters min-queue-count))) + (dump-queues queues core) (when visualization (print* "Press enter to finish...") (read-line)))) @@ -48,23 +44,27 @@ " run-mars [-c|--core size]\n" " [-i|--iterations iters]\n" " [-n|--no-visualization]\n" + " [-m|--min-queue-count]\n" " warrior1.red [warrior2.red [...]]")) (define (main) (let loop ((args (cdr (argv))) (iters 10000) (core-size 8000) - (visualization #t)) + (visualization #t) + (min-queue-count 2)) (match args ((or () ((or "-h" "--help"))) (print-usage)) (((or "-i" "--iterations") istr rest ...) - (loop rest (string->number istr) core-size visualization)) + (loop rest (string->number istr) core-size visualization min-queue-count)) (((or "-c" "--core-size") cstr rest ...) - (loop rest iters (string->number cstr) visualization)) + (loop rest iters (string->number cstr) visualization min-queue-count)) (((or "-n" "--no-visualization") rest ...) - (loop rest iters core-size #f)) + (loop rest iters core-size #f min-queue-count)) + (((or "-m" "--min-queue-count") mstr rest ...) + (loop rest iters core-size visualization (string->number mstr))) ((files ...) - (mars-runner files iters core-size visualization))))) + (mars-runner files iters core-size visualization min-queue-count))))) (main) -- 2.20.1