mbutterick
/
aoc-racket
Archived
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

d09 pt2

Browse Source
master
Matthew Butterick 4 years ago
parent 58bbbef2a8
commit 880cfd5c71
1 changed files with 33 additions and 34 deletions
Show Stats Download Patch File Download Diff File

67
2019/09.rkt
Unescape Escape View File

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