|
|
@ -9,9 +9,9 @@
|
|
|
|
(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 (maybe-enlarge-regs len)
|
|
|
|
(define (maybe-enlarge-regs ptr)
|
|
|
|
(unless (< len (vector-length regs))
|
|
|
|
(unless (< ptr (vector-length regs))
|
|
|
|
(define newvec (make-vector (add1 len) 0))
|
|
|
|
(define newvec (make-vector (add1 ptr) 0))
|
|
|
|
(vector-copy! newvec 0 regs)
|
|
|
|
(vector-copy! newvec 0 regs)
|
|
|
|
(set! regs newvec))
|
|
|
|
(set! regs newvec))
|
|
|
|
regs)
|
|
|
|
regs)
|
|
|
@ -21,19 +21,19 @@
|
|
|
|
(let/ec terminate
|
|
|
|
(let/ec terminate
|
|
|
|
(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)
|
|
|
|
(match-define (list opcode mode-1 mode-2 mode-3)
|
|
|
|
(match inst
|
|
|
|
(match inst
|
|
|
|
[(list d4 d3 d2 d1 d0)
|
|
|
|
[(list d4 d3 d2 d1 d0)
|
|
|
|
(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)
|
|
|
|
(λ (ptr)
|
|
|
|
(define ptr-adjusted (+ ptr offset))
|
|
|
|
(define 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
|
|
|
@ -64,10 +64,8 @@
|
|
|
|
(define thd (match program-or-thread
|
|
|
|
(define thd (match program-or-thread
|
|
|
|
[(? thread? thd) thd]
|
|
|
|
[(? thread? thd) thd]
|
|
|
|
[program (make-runner program)]))
|
|
|
|
[program (make-runner program)]))
|
|
|
|
(let loop ([acc null])
|
|
|
|
(for/list ([val (in-producer thread-receive 'done)])
|
|
|
|
(match (thread-receive)
|
|
|
|
val))
|
|
|
|
['done (reverse acc)]
|
|
|
|
|
|
|
|
[msg (loop (cons msg acc))])))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(check-equal?
|
|
|
|
(check-equal?
|
|
|
|