+(define (make-prog name instrs offset)
+ (list name instrs offset))
+
+(define (prog-name prog) (list-ref prog 0))
+(define (prog-instrs prog) (list-ref prog 1))
+(define (prog-offset prog) (list-ref prog 2))
+
+(define (install-prog prog addr)
+ (let loop ((ptr addr)
+ (instrs (prog-instrs prog)))
+ (unless (null? instrs)
+ (core-set! ptr ((car instrs) 'copy (prog-name prog)))
+ (loop (addr+ ptr 1) (cdr instrs))))
+ (make-player (prog-name prog)
+ (addr+ addr (prog-offset prog))))
+
+(define (can-install-prog? prog-len addr)
+ (let loop ((ptr addr)
+ (remaining prog-len))
+ (if (= remaining 0)
+ #t
+ (if (null? ((core-get ptr) 'name))
+ (loop (addr+ ptr 1)
+ (- remaining 1))
+ #f))))
+
+(define (install-progs progs)
+ (let loop ((players '())
+ (progs-left progs))
+ (if (null? progs-left)
+ players
+ (let ((addr (pseudo-random-integer core-size))
+ (prog (car progs-left)))
+ (if (can-install-prog? (length (prog-instrs prog)) addr)
+ (loop (cons (install-prog prog addr) players)
+ (cdr progs-left))
+ (loop players progs-left))))))
+
+(define (make-player name ptr)
+ (list name ptr))