bugfixese
This commit is contained in:
parent
9164599ced
commit
b4f7763bcc
33
vm.scm
33
vm.scm
|
@ -115,19 +115,35 @@
|
||||||
(define (op impl s k r)
|
(define (op impl s k r)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set! _2 s)
|
(set! _2 s)
|
||||||
(set! _wst (if r _rst _wst))
|
(set! _wst (if r rst wst))
|
||||||
(set! _rst (if r _wst _rst))
|
(set! _rst (if r wst rst))
|
||||||
(if k
|
(if k
|
||||||
(let ((i (car _wst))) (impl) (set-car! _wst i))
|
(let ((i (car _wst)))
|
||||||
|
(display _wst)
|
||||||
|
(display "\n")
|
||||||
|
(display i)
|
||||||
|
(display "\n")
|
||||||
|
(impl)
|
||||||
|
(display _wst)
|
||||||
|
(display "\n")
|
||||||
|
(display i)
|
||||||
|
(display "\n")
|
||||||
|
(set-car! _wst i)
|
||||||
|
)
|
||||||
(impl))))
|
(impl))))
|
||||||
|
|
||||||
|
(define (jmp n)
|
||||||
|
(set! pc (if _2 n (+ pc (s8 n)))))
|
||||||
|
(define (jmpi)
|
||||||
|
(set! pc (+ pc (_load-s16))))
|
||||||
|
|
||||||
; base instruction implementations
|
; base instruction implementations
|
||||||
;
|
;
|
||||||
; these assume that _2, _wst, and _rst are correctly set
|
; these assume that _2, _wst, and _rst are correctly set
|
||||||
; according to the instruction's mode flags.
|
; according to the instruction's mode flags.
|
||||||
(define (brk-impl) (set! done #t))
|
(define (brk-impl) (set! done #t))
|
||||||
(define (jci-impl) (if (= 0 (_pop1)) (set! pc (+ pc 2)) (jmi-impl)))
|
(define (jci-impl) (if (= 0 (_pop1)) (set! pc (+ pc 2)) (jmi-impl)))
|
||||||
(define (jmi-impl) (let ((off (_load-s16))) (set! pc (+ pc off 2))))
|
(define (jmi-impl) (set! pc (+ pc (_load-s16) 2)))
|
||||||
(define (jsi-impl) (_rpush2 (+ pc 2)) (jmi-impl))
|
(define (jsi-impl) (_rpush2 (+ pc 2)) (jmi-impl))
|
||||||
(define (lit-impl) (_read pc) (set! pc (+ pc (if _2 2 1))))
|
(define (lit-impl) (_read pc) (set! pc (+ pc (if _2 2 1))))
|
||||||
(define (inc-impl) (_push (+ (_pop) 1)))
|
(define (inc-impl) (_push (+ (_pop) 1)))
|
||||||
|
@ -141,15 +157,15 @@
|
||||||
(define (neq-impl) (let* ((b (_pop)) (a (_pop))) (_push1 (if (not (= a b)) 0 1))))
|
(define (neq-impl) (let* ((b (_pop)) (a (_pop))) (_push1 (if (not (= a b)) 0 1))))
|
||||||
(define (gth-impl) (let* ((b (_pop)) (a (_pop))) (_push1 (if (> a b) 0 1))))
|
(define (gth-impl) (let* ((b (_pop)) (a (_pop))) (_push1 (if (> a b) 0 1))))
|
||||||
(define (lth-impl) (let* ((b (_pop)) (a (_pop))) (_push1 (if (< a b) 0 1))))
|
(define (lth-impl) (let* ((b (_pop)) (a (_pop))) (_push1 (if (< a b) 0 1))))
|
||||||
(define (jmp-impl) (let ((n (_pop))) (set! pc (if _2 n (+ pc (s8 n))))))
|
(define (jmp-impl) (let ((n (_pop))) (jmp n)))
|
||||||
(define (jcn-impl) (if (= 0 (_pop1)) (_pop) (jmp-impl)))
|
(define (jcn-impl) (let ((n (_pop))) (if (= 0 (_pop1)) '() (jmp n))))
|
||||||
(define (jsr-impl) (_rpush2 pc) (jmp-impl))
|
(define (jsr-impl) (_rpush2 pc) (jmp-impl))
|
||||||
(define (sth-impl) (_rpush (_pop)))
|
(define (sth-impl) (_rpush (_pop)))
|
||||||
(define (ldz-impl) (_read (_pop1)))
|
(define (ldz-impl) (_read (_pop1)))
|
||||||
(define (stz-impl) (let* ((zp (_pop1)) (n (_pop))) (_write zp n)))
|
(define (stz-impl) (let* ((zp (_pop1)) (n (_pop))) (_write zp n)))
|
||||||
(define (ldr-impl) (_read (+ pc (s8 (_pop1)))))
|
(define (ldr-impl) (_read (+ pc (s8 (_pop1)))))
|
||||||
(define (str-impl) (let* ((off (_pop1)) (n (_pop))) (_write (+ pc (s8 off)) n)))
|
(define (str-impl) (let* ((off (_pop1)) (n (_pop))) (_write (+ pc (s8 off)) n)))
|
||||||
(define (lda-impl) (_read (_pop2)))
|
(define (lda-impl) (let ((n (_pop2))) (display "! ") (display n) (display "\n") (_read n)))
|
||||||
(define (sta-impl) (let* ((addr (_pop2)) (n (_pop))) (_write addr n)))
|
(define (sta-impl) (let* ((addr (_pop2)) (n (_pop))) (_write addr n)))
|
||||||
(define (add-impl) (let* ((b (_pop)) (a (_pop))) (_push (+ a b))))
|
(define (add-impl) (let* ((b (_pop)) (a (_pop))) (_push (+ a b))))
|
||||||
(define (sub-impl) (let* ((b (_pop)) (a (_pop))) (_push (- a b))))
|
(define (sub-impl) (let* ((b (_pop)) (a (_pop))) (_push (- a b))))
|
||||||
|
@ -254,9 +270,6 @@
|
||||||
(if done '()
|
(if done '()
|
||||||
(let* ((byte (vector-ref mem pc))
|
(let* ((byte (vector-ref mem pc))
|
||||||
(fn (vector-ref instructions byte)))
|
(fn (vector-ref instructions byte)))
|
||||||
;; (display "*** ")
|
|
||||||
;; (display byte)
|
|
||||||
;; (display "\n")
|
|
||||||
(set! pc (+ pc 1))
|
(set! pc (+ pc 1))
|
||||||
(fn)
|
(fn)
|
||||||
(u:eval))))
|
(u:eval))))
|
||||||
|
|
Loading…
Reference in New Issue