master
Matthew Butterick 4 years ago
parent 65a9de8601
commit 285da9a99a

@ -22,38 +22,37 @@
(let loop ([ptr 0]) (let loop ([ptr 0])
(define inst (for/list ([c (in-string (~r (reg-ref ptr) #:min-width 5 #:pad-string "0"))]) (define inst (for/list ([c (in-string (~r (reg-ref ptr) #:min-width 5 #:pad-string "0"))])
(string->number (string c)))) (string->number (string c))))
(match-define (list opcode mode-1 mode-2 mode-3) (define-values (opcode resolve)
(match inst (match inst
[(list d4 d3 d2 d1 d0) [(list d4 d3 d2 d1 d0)
(cons (+ (* 10 d1) d0) (values (+ (* 10 d1) d0)
(for/list ([mode-val (list d2 d3 d4)] (λ (ptr offset)
[offset '(1 2 3)]) (define parameter-value (match offset [1 d2] [2 d3] [3 d4]))
(λ (ptr) (define ptr-resolver (match parameter-value
(define ptr-adjusted (+ ptr offset)) [0 reg-ref] ; position
(match mode-val [1 values] ; immediate
[0 (reg-ref ptr-adjusted)] ; position [2 (compose1 (λ (ptr) (+ relative-base ptr)) reg-ref)])); relative
[1 ptr-adjusted] ; immediate (ptr-resolver (+ ptr offset))))]))
[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) ((match opcode (reg-set! (resolve ptr 3) ((match opcode
[1 +] [1 +]
[2 *] [2 *]
[7 (binarize <)] [7 (binarize <)]
[8 (binarize =)]) (reg-ref (mode-1 ptr)) (reg-ref (mode-2 ptr)))) [8 (binarize =)]) (reg-ref (resolve ptr 1)) (reg-ref (resolve ptr 2))))
(+ 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) (thread-receive))] [3 (reg-set! (resolve ptr 1) (thread-receive))]
[4 (thread-send calling-thd (reg-ref (mode-1 ptr)))] [4 (thread-send calling-thd (reg-ref (resolve ptr 1)))]
[9 (set! relative-base (+ relative-base (reg-ref (mode-1 ptr))))]) [9 (set! relative-base (+ relative-base (reg-ref (resolve ptr 1))))])
(+ 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? (reg-ref (mode-1 ptr)))) [6 values]) (zero? (reg-ref (resolve ptr 1))))
(reg-ref (mode-2 ptr)) (reg-ref (resolve ptr 2))
(+ 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)]))