67 lines
2.1 KiB
Scheme
67 lines
2.1 KiB
Scheme
(use-modules (d- test))
|
||
|
||
|
||
;;; VM tests
|
||
(use-modules (scmvm vm)
|
||
(rnrs bytevectors)
|
||
(rnrs io ports))
|
||
|
||
(define adder-program
|
||
#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
|
||
#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
|
||
))
|
||
|
||
(define-test-suite "VM"
|
||
(define-test "adder"
|
||
(define my-vm (make-vm))
|
||
(define my-program (open-bytevector-input-port adder-program))
|
||
(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 6)
|
||
(define my-program (open-bytevector-input-port fib-program))
|
||
(run-vm my-vm my-program)
|
||
(assert-equal 8 (vm-memory-ref my-vm 1))))
|