The internal state of an instance of an “intcode machine” has a few compoents:
(define ip 0) ; instruction pointer
(define relative-base 0) ; offset pointer
(define memory-1 (vector-copy program)) ; memory (also initially the program)
(define memory-2 (make-eq-hashtable)) ; extra memory for out of range references
(define in '()) ; input signals
(define out '()) ; output signals
(define size (vector-length memory-1)) ; size (for use in indexing)A hashtable is used for the second level of member because it will rarely be needed because the spec wants it to handle possibly very out of range addresses.
The memory-1 is copied to a vector from the input program to make
restarts easier. The following internal function is called upon
receiving a request to reset:
(define reset!
(case-lambda
(()
(set! memory-1 (vector-copy program))
(set! memory-2 (make-eq-hashtable))
(set! ip 0)
(set! relative-base 0)
(set! in '())
(set! out '()))
((m1* m2* ip* rb* in* out*)
(set! memory-1 m1*)
(set! memory-2 m2*)
(set! ip ip*)
(set! relative-base rb*)
(set! in in*)
(set! out out*))))A few (unnecessary, but convenient) helpers to increment the pointers
(define (ip! dx)
(set! ip (fx+ ip dx)))
(define (rb! dx)
(set! relative-base (fx+ relative-base dx)))The local variable size is used to decide which level of memory to load or store values. These two functions are the final step after decoding the opcode and how it indicates the parameters should be referenced. Getting this right was easily the most unpleasant part of implementing the intcode spec.
(define (store! addr val)
(if (fx< addr size)
(vector-set! memory-1 addr val)
(hashtable-set! memory-2 addr val)))
(define (ref addr)
(if (fx< addr size)
(vector-ref memory-1 addr)
(hashtable-ref memory-2 addr 0)))So, the first two digits (little endian) of an instruction that’s been
pointed to by ip determine which instruction to do. The other digits
determine how the arguments for the instruction are referenced.
- 0 =>
mem[mem[ip+param]]reference twice like 2 but without relative base pointer. - 1 =>
mem[ip + param]the simple case, no gymnastics. - 2 =>
mem[rb + mem[ip+param]]reference the parameter then use relative base to reference once more.
It is not strictly necessary to split up val and addr, but it’s a
slight convenience and helps avoid decoding the opcode digits multiple
times for parameters. Actually! Writing this up helped me spot a
problem, in step digits should be decoded once and not within the
val and addr functions!. Seeming more and more like literate
programming is useful, though more work… fixme!
(define (val opcode param)
(case (digit-at param opcode)
((1) (ref (fx+ ip param)))
((2) (ref (fx+ relative-base (ref (fx+ ip param)))))
((0) (ref (ref (fx+ ip param))))))
(define (addr opcode param)
(case (digit-at param opcode)
((2) (fx+ relative-base (ref (fx+ ip param))))
((0) (ref (fx+ ip param)))
((1) (error 'intcode "addr is immediate" opcode param))))The wonky ordering of the modes is informed by profiling the various puzzles using chez’s lovely tooling.
For maximal flexibility, I implement the interpreting as small step. This means the owner of an intcode cell can have fine-grained control over how it wants to run an intcode program. Opcodes correspond to the following operations:
- 1 => add
- 2 => mul
- 3 => read in
- 4 => put out
- 5 => jump if not zero
- 6 => jump if zero
- 7 => store comparison <
- 8 => store comparison =
- 9 => increment relative base
- 99 => finish
(define (step)
(let ((op (ref ip)))
(case (fxmod op 100)
((1) (store! (addr op 3) (fx+ (val op 1) (val op 2))) (ip! 4) 'ok)
((2) (store! (addr op 3) (fx* (val op 1) (val op 2))) (ip! 4) 'ok)
((3) (if (null? in)
'blocked
(begin (store! (addr op 1) (pop! in)) (ip! 2) 'ok)))
((4) (push! (val op 1) out) (ip! 2) 'out)
((5) (if (fxzero? (val op 1)) (ip! 3) (set! ip (val op 2))) 'ok)
((6) (if (fxzero? (val op 1)) (set! ip (val op 2)) (ip! 3)) 'ok)
((7) (store! (addr op 3) (if (fx< (val op 1) (val op 2)) 1 0)) (ip! 4) 'ok)
((8) (store! (addr op 3) (if (fx= (val op 1) (val op 2)) 1 0)) (ip! 4) 'ok)
((9) (rb! (val op 1)) (ip! 2) 'ok)
((99) 'done)
(else (error 'intcode "bad opcode" op)))))Being local state cells, these things dispatch on request messages à
la SICP and scheme tradition. Here is the handler and the final
expression in the incode definition’s body:
(lambda (me . args)
(case me
((step) (step))
((in) (set! in `(,@in ,@args)) 'ok)
((peek-out) (and (not (null? out)) (car out)))
((read-out!) (let ((tmp (reverse out))) (set! out '()) tmp))
((ref) (apply ref args))
((set!) (apply store! args))
((reset!) (apply reset! args))
((program) program)
((core-dump) (list program memory-1 memory-2 ip relative-base in out))
(else (error 'cpu "unknown message" me))))(define (intcode program)
<<intcode-local-state>>
<<reset>>
<<increment>>
<<store/load>>
<<val/addr>>
<<small-step>>
<<intcode-handler>>)(define-syntax push!
(lambda (x)
(syntax-case x ()
((_ x xs)
#'(set! xs (cons x xs))))))
(define-syntax pop!
(lambda (x)
(syntax-case x ()
((_ xs)
#'(let ((x (car xs)))
(set! xs (cdr xs))
x)))))
(define (digit-at i n)
(fxmod (fx/ n (expt 10 (fx+ i 1))) 10))Functions that make it easier to deal with intcode cells, passing appropriate symbols and arguments to some functions.
(define (intcode-ref M addr)
(M 'ref addr))
(define (intcode-set! M addr val)
(M 'set! addr val))
(define (reset-intcode M)
(M 'reset!))
(define (step M)
(M 'step))
(define (send-input M . values)
(apply M 'in values))
(define (read-output M)
(M 'read-out!))
(define (peek-output M)
(M 'peek-out))
(define (run-until status M)
(let run ((s (step M)))
(if (memq s status) s (run (step M)))))
(define (run-until-halt M)
(run-until '(done blocked) M))
(define (done? M)
(eq? 'done (step M)))
(define (blocked? M)
(eq? 'blocked (step M)))
(define (core-dump M)
(M 'core-dump))
(define (read-input M)
(list-ref (core-dump M) 5))
(define (fork-intcode M)
(apply (lambda (p m1 m2 i r in out)
(define M* (intcode p))
(M* 'reset! (vector-copy m1) (hashtable-copy m2 #t) i r in out)
M*)
(core-dump M)))
(define (run-intcode program . input)
(define M (intcode program))
(apply M 'in input)
(run-until-halt M)
(read-output M))(define (parse-intcode . port)
(define in
(if (null? port) (current-input-port) (car port)))
(let lp ((x (read-char in)) (negative? #f) (n 0) (program '()))
(cond
((or (eof-object? x) (and (char=? #\newline x)
(eof-object? (peek-char in))))
(list->vector
(reverse
(if negative?
(cons (- n) program)
(cons n program)))))
((char<=? #\0 x #\9)
(lp (read-char in) negative? (+ (* 10 n) (char->integer x) -48) program))
((char=? x #\,)
(if negative?
(lp (read-char in) #f 0 (cons (- n) program))
(lp (read-char in) #f 0 (cons n program))))
((char=? x #\-)
(lp (read-char in) #t n program))
(else
(format "unexpected char: ~s at index ~a~%" x (port-position in))))))And for racket, no error reporting, but much nicer!
(define (parse-intcode . port)
(define in (if (null? port) (current-input-port) (car port)))
(list->vector (map string->number (string-split (read-line in) ","))))step ; small step
intcode-ref ; read intcode memory at address
intcode-set! ; set intcdoe memory at address to value
send-input ; send list of values to intcode
read-output ; read outputs of intcode, popping them
peek-output ; read last output of intcode, leaving unchanged
read-input ; inspect machine's input
run-until ; run intcode until given state is reacned
run-until-halt ; (run-until '(blocked done) machine)
done? ; (eq? 'done (status machine))
blocked? ; (eq? blocked (status machine))
parse-intcode ; parse a port containing comma-separated ints
intcode ; create an intcode from a list of ints
run-intcode ; run an intcode program given by vector of ints and given inputs
fork-intcode ; copy an intcode's state to a new intcode
reset-intcode ; reset an intcode's stateThis is a r6rs scheme library and is known by me to work with at least ChezScheme and GNU Guile.
Originally written in ChezScheme, my preferred scheme at the moment, and thus the simplest scheme to package for. Whats missing is an easy way to parse the comma separated ints.
(library (intcode)
(export ; export-list
<<exports>>
)
(import (chezscheme))
<<intcode>>
<<misc>>
<<r6rs-parse-intcode>>
<<library-interface>>)Easiest route is probably using r6rs. Guile is has slightly different hashtable fixnum interfaces, so a small compatability wrapper is in order.
(define fx/ fxdiv)
(define fx< fx<?)
(define fx= fx=?)#!r6rs
(library (intcode)
(export ; export-list
<<exports>>
)
(import (rnrs))
<<intcode>>
<<r6rs-parse-intcode>>
<<misc>>
<<guile-compat>>
<<library-interface>>)A shim:
(define fxmod unsafe-fxmodulo)
(define fx/ unsafe-fxquotient)
(define fx+ unsafe-fx+)
(define fx* unsafe-fx*)
(define make-eq-hashtable make-hasheq)
(define hashtable-set! hash-set!)
(define hashtable-ref hash-ref)
(define (fxzero? x)
(unsafe-fx= 0 x))
(define (hashtable-copy T mut?)
(hash-copy T))#lang racket
(require racket/unsafe/ops
racket/fixnum)
(provide ; provisions
<<exports>>
)
<<intcode>>
<<racket-parse-intcode>>
<<library-interface>>
<<racket-compat>>
<<misc>>