d6
/
uxn-scm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

bugfixese

This commit is contained in:
~d6 2025-01-19 18:28:36 -05:00
parent 9164599ced
commit b4f7763bcc
1 changed files with 23 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
vm.scm
View File

@ -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))))