dane/scm-to-vm
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make assembler take a port

Browse Source
This commit is contained in:
Dane Johnson 2025-01-07 10:50:23 -06:00
parent e252e8eb19
commit f8a868bb23
2 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
scmvm/assembler.scm
View File

@ -2,6 +2,7 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (scmvm vm) #:use-module (scmvm vm)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module ((scheme base) #:use-module ((scheme base)
#:select (write-u8 write-bytevector)) #:select (write-u8 write-bytevector))
#:export (assemble)) #:export (assemble))
@ -33,7 +34,9 @@
(bytevector-s32-native-set! bv 0 word) (bytevector-s32-native-set! bv 0 word)
(write-bytevector bv)) (write-bytevector bv))
(define (assemble inst-seq) (define (assemble inst-seq port)
(with-output-to-port port
(lambda ()
(define labels (find-labels inst-seq 0)) (define labels (find-labels inst-seq 0))
(let loop ([seq inst-seq]) (let loop ([seq inst-seq])
(cond (cond
@ -46,4 +49,4 @@
(case (instruction-type inst-obj) (case (instruction-type inst-obj)
[(i) (write-word (cadr inst))] [(i) (write-word (cadr inst))]
[(j) (write-word (assq-ref labels (cadr inst)))]) [(j) (write-word (assq-ref labels (cadr inst)))])
(loop (cdr seq)))]))) (loop (cdr seq)))])))))

4
tests.scm
View File

@ -102,11 +102,11 @@
(define-test-suite "assembler" (define-test-suite "assembler"
(define-test "adder" (define-test "adder"
(define out (open-output-bytevector)) (define out (open-output-bytevector))
(with-output-to-port out (lambda () (assemble adder-program-asm))) (assemble adder-program-asm out)
(assert-equal adder-program-bytecode (get-output-bytevector out))) (assert-equal adder-program-bytecode (get-output-bytevector out)))
(define-test "fib" (define-test "fib"
(define out (open-output-bytevector)) (define out (open-output-bytevector))
(with-output-to-port out (lambda () (assemble fib-program-asm))) (assemble fib-program-asm out)
(assert-equal fib-program-bytecode (get-output-bytevector out)))) (assert-equal fib-program-bytecode (get-output-bytevector out))))
(define-test-suite "vm" (define-test-suite "vm"