master
Matthew Butterick 5 years ago
parent 7893490c8d
commit 7b0cc2c4fe

@ -12,12 +12,13 @@
(define (reg-set! ptr val) (vector-set! regs (reg-ref ptr) val)) (define (reg-set! ptr val) (vector-set! regs (reg-ref ptr) val))
(let/ec terminate (let/ec terminate
(let loop ([ptr 0]) (let loop ([ptr 0])
(match-define (list opcode mode1 mode2 mode3) (match-define (list opcode mode-1 mode-2 mode-3)
(match (for/list ([c (in-string (~r (reg-ref ptr) #:min-width 5 #:pad-string "0"))]) (match (for/list ([c (in-string (~r (reg-ref ptr) #:min-width 5 #:pad-string "0"))])
(string->number (string c))) (string->number (string c)))
[(list d4 d3 d2 d1 d0) (cons (+ (* 10 d1) d0) [(list d4 d3 d2 d1 d0) (cons (+ (* 10 d1) d0)
(for/list ([mode (list d2 d3 d4)]) (for/list ([mode-val (list d2 d3 d4)]
(if (zero? mode) reg-ref values)))])) [offset '(1 2 3)])
(λ (ptr) ((if (zero? mode-val) reg-ref values) (reg-ref (+ ptr offset))))))]))
(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
@ -25,19 +26,18 @@
[1 +] [1 +]
[2 *] [2 *]
[7 (binarize <)] [7 (binarize <)]
[8 (binarize =)]) (mode1 (reg-ref (+ ptr 1))) [8 (binarize =)]) (mode-1 ptr) (mode-2 ptr)))
(mode2 (reg-ref (+ ptr 2)))))
(+ ptr 4)] (+ ptr 4)]
[(or 3 4) ; 2-arity: input & output [(or 3 4) ; 2-arity: input & output
(match opcode (match opcode
[3 (reg-set! (+ ptr 1) starting-input)] [3 (reg-set! (+ ptr 1) starting-input)]
[4 (println (reg-ref (mode1 (+ ptr 1))))]) [4 (println (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? (mode1 (reg-ref (+ ptr 1))))) [6 values]) (zero? (mode-1 ptr)))
(mode2 (reg-ref (+ ptr 2))) (mode-2 ptr)
(+ ptr 3))] (+ ptr 3))]
[99 (terminate)] [99 (terminate)]
[_ (error 'unknown-opcode)])) [_ (error 'unknown-opcode)]))