124 lines
3.2 KiB
Scheme
124 lines
3.2 KiB
Scheme
(use-modules (d- test)
|
||
(scmvm assembler)
|
||
(scmvm vm)
|
||
(rnrs bytevectors)
|
||
(rnrs io ports)
|
||
((scheme base)
|
||
#:select (open-output-bytevector get-output-bytevector)))
|
||
|
||
;;; Data
|
||
(define adder-program-asm
|
||
'((push 1)
|
||
(push 2)
|
||
(+)
|
||
(store #x01)))
|
||
|
||
(define fib-program-asm
|
||
'( (load 1)
|
||
(call fib)
|
||
(jmp cleanup)
|
||
fib
|
||
(dup)
|
||
(push 0)
|
||
(=)
|
||
(if not0)
|
||
(pop)
|
||
(pop)
|
||
(push 0)
|
||
(return)
|
||
not0
|
||
(pop)
|
||
(dup)
|
||
(push 1)
|
||
(=)
|
||
(if not1)
|
||
(pop)
|
||
(pop)
|
||
(push 1)
|
||
(return)
|
||
not1
|
||
(pop)
|
||
(push 1)
|
||
(-)
|
||
(dup)
|
||
(call fib)
|
||
(swap)
|
||
(push 1)
|
||
(-)
|
||
(call fib)
|
||
(+)
|
||
(return)
|
||
cleanup
|
||
(store #x1)))
|
||
|
||
(define adder-program-bytecode
|
||
#vu8(#x01 1 0 0 0 ; Push value "1"
|
||
#x01 2 0 0 0 ; Push value "2"
|
||
#x05 ; Perform "+"
|
||
#x03 1 0 0 0 ; Store the value to memory address 1
|
||
))
|
||
|
||
(define fib-program-bytecode
|
||
#vu8(#x04 1 0 0 0 ; 0 load "n" from memory address 0x01
|
||
#x0d 15 0 0 0 ; 5 call fib procedure
|
||
#x16 83 0 0 0 ; 10 jump to cleanup
|
||
;; "fib" procedure
|
||
#x14 ; 15 duplicate n
|
||
#x01 0 0 0 0 ; 16 push 0
|
||
#x11 ; 21 test equality
|
||
#x0c 35 0 0 0 ; 22 if
|
||
#x02 ; 27 pop tested value
|
||
#x02 ; 28 pop n
|
||
#x01 0 0 0 0 ; 29 push '0'
|
||
#x0e ; 31 return
|
||
#x02 ; 35 pop tested value
|
||
#x14 ; 36 duplicate n
|
||
#x01 1 0 0 0 ; 37 push 1
|
||
#x11 ; 42 test equality
|
||
#x0c 56 0 0 0 ; 43 if
|
||
#x02 ; 48 pop tested value
|
||
#x02 ; 49 pop n
|
||
#x01 1 0 0 0 ; 50 push '1'
|
||
#x0e ; 55 return
|
||
#x02 ; 56 pop tested value
|
||
;; recursively calculate fib (n - 1)
|
||
#x01 1 0 0 0 ; 57 push 1
|
||
#x06 ; 62 (n - 1)
|
||
#x14 ; 63 duplicate (n - 1) as an arg
|
||
#x0d 15 0 0 0 ; 64 call fib
|
||
;; recursively calculate fib (n - 2)
|
||
#x15 ; 69 swap n - 1 back atop stack
|
||
#x01 1 0 0 0 ; 70 push 1
|
||
#x06 ; 75 (n - 2)
|
||
#x0d 15 0 0 0 ; 76 call fib
|
||
#x05 ; 81 (fib(n - 1) + fib (n - 2))
|
||
#x0e ; 82 return
|
||
;; cleanup
|
||
#x03 1 0 0 0 ; 83 store fib(n) to memory address 0x01
|
||
))
|
||
|
||
|
||
;;; Tests
|
||
(define-test-suite "assembler"
|
||
(define-test "adder"
|
||
(define out (open-output-bytevector))
|
||
(assemble adder-program-asm out)
|
||
(assert-equal adder-program-bytecode (get-output-bytevector out)))
|
||
(define-test "fib"
|
||
(define out (open-output-bytevector))
|
||
(assemble fib-program-asm out)
|
||
(assert-equal fib-program-bytecode (get-output-bytevector out))))
|
||
|
||
(define-test-suite "vm"
|
||
(define-test "adder"
|
||
(define my-vm (make-vm))
|
||
(define my-program (open-bytevector-input-port adder-program-bytecode))
|
||
(run-vm my-vm my-program)
|
||
(assert-equal 3 (vm-memory-ref my-vm 1)))
|
||
(define-test "fib"
|
||
(define my-vm (make-vm))
|
||
(vm-memory-set! my-vm 1 10)
|
||
(define my-program (open-bytevector-input-port fib-program-bytecode))
|
||
(run-vm my-vm my-program)
|
||
(assert-equal 55 (vm-memory-ref my-vm 1))))
|