-(define (make-instr opcode modifier A-mode A-num B-mode B-num))
-(define (instr-opcode instr) (list-ref instr 0))
-(define (instr-modifier instr) (list-ref instr 1))
-(define (instr-A-mode instr) (list-ref instr 2))
-(define (instr-A-num instr) (list-ref instr 3))
-(define (instr-B-mode instr) (list-ref instr 4))
-(define (instr-B-num instr) (list-ref instr 5))
-
-
-;;; Players
-;;
-
-(define (make-player name . ptrs)
- (cons name ptrs))
-
-(define (player-ptrs player)
- (cdr player))
-
-(define (player-name player)
- (car player))
+(define (make-prog name instrs offset)
+ (list name instructions 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)
+ (vector-set! core ptr (instr-copy (car instrs)))
+ (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 ((vector-ref core ptr) 'name)
+ #f
+ (loop (addr+ ptr 1)
+ (- remaining 1))))))
+
+(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))