make-queue
queue-owner
queue-ptrs
- dump-queue
+ dump-queues
make-core
run-mars)
(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))
(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
(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"
;;; 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 ")")