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

clean up code and get drifloon test passing

This commit is contained in:
~d6 2025-01-20 00:29:59 -05:00
parent e2f9abb5ff
commit ec1e7e3d69
1 changed files with 8 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
vm.scm
View File

@ -111,6 +111,7 @@
(lo (vector-ref mem (u16 (+ pc 1))))) (lo (vector-ref mem (u16 (+ pc 1)))))
(s16 (hilo->u16 hi lo)))) (s16 (hilo->u16 hi lo))))
; restore a stack pointer when in keep mode
(define (restore k) (define (restore k)
(if (null? k) (if (null? k)
'() '()
@ -126,6 +127,7 @@
(define (jmp n) (define (jmp n)
(set! pc (if _2 n (+ pc (s8 n))))) (set! pc (if _2 n (+ pc (s8 n)))))
(define (jmi) (define (jmi)
(let ((offset (_load-s16))) (let ((offset (_load-s16)))
(set! pc (+ pc offset 2)))) (set! pc (+ pc offset 2))))
@ -141,7 +143,7 @@
(define (jmi-impl k) (jmi)) (define (jmi-impl k) (jmi))
(define (jsi-impl k) (_rpush2 (+ pc 2)) (jmi)) (define (jsi-impl k) (_rpush2 (+ pc 2)) (jmi))
(define (lit-impl k) (_read pc 65536) (set! pc (+ pc (if _2 2 1)))) (define (lit-impl k) (_read pc 65536) (set! pc (+ pc (if _2 2 1))))
(define (inc-impl k) (let* ((a (_pop)) (_ (restore k))) (_push (+ a 1)))) (define (inc-impl k) (let* ((a (_pop))) (restore k) (_push (+ a 1))))
(define (pop-impl k) (_pop) (restore k)) (define (pop-impl k) (_pop) (restore k))
(define (nip-impl k) (let* ((a (_pop)) (_ (_pop))) (restore k) (_push a))) (define (nip-impl k) (let* ((a (_pop)) (_ (_pop))) (restore k) (_push a)))
(define (swp-impl k) (let* ((b (_pop)) (a (_pop))) (restore k) (_push b) (_push a))) (define (swp-impl k) (let* ((b (_pop)) (a (_pop))) (restore k) (_push b) (_push a)))
@ -159,7 +161,7 @@
(define (ldz-impl k) (let* ((zp (_pop1))) (restore k) (_read zp 256))) (define (ldz-impl k) (let* ((zp (_pop1))) (restore k) (_read zp 256)))
(define (stz-impl k) (let* ((zp (_pop1)) (n (_pop))) (restore k) (_write zp n 256))) (define (stz-impl k) (let* ((zp (_pop1)) (n (_pop))) (restore k) (_write zp n 256)))
(define (ldr-impl k) (let* ((r (_pop1))) (restore k) (_read (+ pc (s8 r)) 65536))) (define (ldr-impl k) (let* ((r (_pop1))) (restore k) (_read (+ pc (s8 r)) 65536)))
(define (str-impl k) (let* ((off (_pop1)) (n (_pop))) (restore k) (_write (+ pc (s8 off)) n 65536))) (define (str-impl k) (let* ((r (_pop1)) (n (_pop))) (restore k) (_write (+ pc (s8 r)) n 65536)))
(define (lda-impl k) (let ((n (_pop2))) (restore k) (_read n 65536))) (define (lda-impl k) (let ((n (_pop2))) (restore k) (_read n 65536)))
(define (sta-impl k) (let* ((addr (_pop2)) (n (_pop))) (restore k) (_write addr n 65536))) (define (sta-impl k) (let* ((addr (_pop2)) (n (_pop))) (restore k) (_write addr n 65536)))
(define (add-impl k) (let* ((b (_pop)) (a (_pop))) (restore k) (_push (+ a b)))) (define (add-impl k) (let* ((b (_pop)) (a (_pop))) (restore k) (_push (+ a b))))
@ -186,15 +188,6 @@
(define (deo-impl k) (define (deo-impl k)
(let* ((dev (_pop1)) (n (_pop))) (let* ((dev (_pop1)) (n (_pop)))
(restore k) (restore k)
;; (display "deo-impl 2=")
;; (display _2)
;; (display " k=")
;; (display k)
;; (display " n=")
;; (display n)
;; (display " dev=")
;; (display dev)
;; (display "\n")
(if _2 (if _2
(begin (begin
(_deo (u16->hi n) dev) (_deo (u16->hi n) dev)
@ -226,7 +219,7 @@
(vector-set! instructions (+ base 96) (op impl #t #f #t)) ; 2-r (vector-set! instructions (+ base 96) (op impl #t #f #t)) ; 2-r
(vector-set! instructions (+ base 128) (op impl #f #t #f)) ; -k- (vector-set! instructions (+ base 128) (op impl #f #t #f)) ; -k-
(vector-set! instructions (+ base 160) (op impl #t #t #f)) ; 2k- (vector-set! instructions (+ base 160) (op impl #t #t #f)) ; 2k-
(vector-set! instructions (+ base 192) (op impl #t #f #t)) ; 2-r (vector-set! instructions (+ base 192) (op impl #f #t #t)) ; -kr
(vector-set! instructions (+ base 224) (op impl #t #t #t))) ; 2kr (vector-set! instructions (+ base 224) (op impl #t #t #t))) ; 2kr
; hardcoded instructions for base 0x00 ; hardcoded instructions for base 0x00
@ -322,7 +315,8 @@
(define (u:read-stdin port) (define (u:read-stdin port)
(let ((c (read-char port))) (let ((c (read-char port)))
(if (eof-object? c) '() (if (eof-object? c)
(u:send-input #\newline 4)
(begin (begin
(u:send-input c 1) (u:send-input c 1)
(u:read-stdin port))))) (u:read-stdin port)))))
@ -345,6 +339,6 @@
(vector-set! dev 23 (if (null? rom-args) 0 1)) (vector-set! dev 23 (if (null? rom-args) 0 1))
(u:load-rom rom start) (u:load-rom rom start)
(u:run start) (u:run start)
(u:read-args rom-args) (if (null? rom-args) '() (u:read-args rom-args))
(u:read-stdin (current-input-port)) (u:read-stdin (current-input-port))
(exit 0)))) (exit 0))))