master
Matthew Butterick 4 years ago
parent 58bbbef2a8
commit 880cfd5c71

@ -9,22 +9,14 @@
(define (make-runner program [calling-thd (current-thread)])
(thread (λ ()
(define regs (string->regs program))
(define (grow-regs! len)
(define (maybe-enlarge-regs len)
(unless (< len (vector-length regs))
(define newvec (make-vector (add1 len) 0))
(vector-copy! newvec 0 regs)
(set! regs newvec))
(define (reg-ref ptr)
(cond
[(< ptr (vector-length regs)) (vector-ref regs ptr)]
[else
(grow-regs! (add1 ptr))
(reg-ref ptr)]))
(define (reg-set! ptr val)
(cond
[(< ptr (vector-length regs)) (vector-set! regs ptr val)]
[else
(grow-regs! (add1 ptr))
(reg-set! ptr val)]))
regs)
(define (reg-ref ptr) (vector-ref (maybe-enlarge-regs ptr) ptr))
(define (reg-set! ptr val) (vector-set! (maybe-enlarge-regs ptr) ptr val))
(define relative-base 0)
(let/ec terminate
(let loop ([ptr 0])
@ -36,36 +28,35 @@
(cons (+ (* 10 d1) d0)
(for/list ([mode-val (list d2 d3 d4)]
[offset '(1 2 3)])
(λ (ptr [io-mode? 'read])
((if (eq? io-mode? 'read) reg-ref values)
(let ([ptr-adjusted (+ ptr offset)])
(λ (ptr)
(define ptr-adjusted (+ ptr offset))
(match mode-val
[0 (reg-ref ptr-adjusted)] ; position
[1 ptr-adjusted] ; immediate
[2 (+ relative-base (reg-ref ptr-adjusted))]))))))])) ; relative
[2 (+ relative-base (reg-ref ptr-adjusted))]))))])) ; relative
(define next-ptr
(match opcode
[(or 1 2 7 8) ; 4-arity: add & multiply & compare
(reg-set! (mode-3 ptr 'write) ((match opcode
(reg-set! (mode-3 ptr) ((match opcode
[1 +]
[2 *]
[7 (binarize <)]
[8 (binarize =)]) (mode-1 ptr) (mode-2 ptr)))
[8 (binarize =)]) (reg-ref (mode-1 ptr)) (reg-ref (mode-2 ptr))))
(+ ptr 4)]
[(or 3 4 9) ; 2-arity: input & output
(match opcode
[3 (reg-set! (mode-1 ptr 'write) (thread-receive))]
[4 (thread-send calling-thd (mode-1 ptr))]
[9 (set! relative-base (+ relative-base (mode-1 ptr)))])
[3 (reg-set! (mode-1 ptr) (thread-receive))]
[4 (thread-send calling-thd (reg-ref (mode-1 ptr)))]
[9 (set! relative-base (+ relative-base (reg-ref (mode-1 ptr))))])
(+ ptr 2)]
[(or 5 6) ; 3-arity: jump
(if ((match opcode
[5 not]
[6 values]) (zero? (mode-1 ptr)))
(mode-2 ptr)
[6 values]) (zero? (reg-ref (mode-1 ptr))))
(reg-ref (mode-2 ptr))
(+ ptr 3))]
[99 (thread-send calling-thd 'done) (terminate)]
[_ (error "unknown-opcode" opcode)]))
[_ (error "unknown opcode" opcode)]))
(loop next-ptr))))))
@ -92,8 +83,16 @@
(run "104,1125899906842624,99")
'(1125899906842624))
;; 1
(define t1 (make-runner (file->string "09.rktd")))
(thread-send t1 1)
(check-equal?
(run t1)
'(3601950151))
;; 2
(define t2 (make-runner (file->string "09.rktd")))
(thread-send t2 2)
(check-equal?
(run t2)
'(64236))