134 lines
3.5 KiB
Scheme
134 lines
3.5 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
|
||
'((variable result 0)
|
||
(push 1)
|
||
(push 2)
|
||
(+)
|
||
(push result)
|
||
(!)
|
||
(bye)))
|
||
|
||
(define fib-program-asm
|
||
'( (variable result 0)
|
||
(push result)
|
||
(@)
|
||
(push fib)
|
||
(call)
|
||
(push cleanup)
|
||
(jmp)
|
||
fib
|
||
(dup)
|
||
(push 0)
|
||
(=)
|
||
(over)
|
||
(push 1)
|
||
(=)
|
||
(or)
|
||
(push recur)
|
||
(branch)
|
||
(return)
|
||
recur
|
||
(dup)
|
||
(push 1)
|
||
(-)
|
||
(push fib)
|
||
(call)
|
||
(over)
|
||
(push 2)
|
||
(-)
|
||
(push fib)
|
||
(call)
|
||
(+)
|
||
(nip)
|
||
(return)
|
||
cleanup
|
||
(push result)
|
||
(!)
|
||
(bye)))
|
||
|
||
(define adder-program-bytecode
|
||
#vu8(0 0 0 0 ; Memory address of the result
|
||
#x01 1 0 0 0 ; Push value "1"
|
||
#x01 2 0 0 0 ; Push value "2"
|
||
#x04 ; Perform "+"
|
||
#x01 1 0 0 0 ; Push the address of the result
|
||
#x02 ; Store the value
|
||
#xff ; Exit the program
|
||
))
|
||
|
||
(define fib-program-bytecode
|
||
#vu8(0 0 0 0 ; Memory address of the input, will also store the result
|
||
#x1 1 0 0 0 ; Push address of the input
|
||
#x03 ; Fetch "n"
|
||
#x1 23 0 0 0 ; Push address of "fib"
|
||
#x10 ; Call
|
||
#x01 74 0 0 0 ; Push address of "cleanup"
|
||
#x0e ; Jump
|
||
;; "fib" procedure ( n -- fib(n) )
|
||
#x16 ; Duplicate n
|
||
#x01 0 0 0 0 ; Push 0
|
||
#x0b ; Test equality
|
||
#x19 ; Over
|
||
#x01 1 0 0 0 ; Push 1
|
||
#x0b ; Test equality
|
||
#x07 ; OR the values of the last two tests
|
||
#x01 45 0 0 0 ; Push address of "recur"
|
||
#x0f ; Branch
|
||
#x11 ; Return
|
||
;; "recur" label
|
||
;; recursively calculate fib (n - 1)
|
||
#x16 ; Dupe "n"
|
||
#x01 1 0 0 0 ; Push 1
|
||
#x05 ; (n - 1)
|
||
#x01 23 0 0 0 ; Push address of "fib"
|
||
#x10 ; Call
|
||
;; recursively calculate fib (n - 2)
|
||
#x19 ; Dupe n over the result
|
||
#x01 2 0 0 0 ; Push 2
|
||
#x05 ; (n - 2)
|
||
#x01 23 0 0 0 ; Push address of fib
|
||
#x10 ; Call
|
||
#x04 ; (fib(n - 1) + fib (n - 2))
|
||
#x15 ; Nip the dupe of "n"
|
||
#x11 ; Return
|
||
;; cleanup
|
||
#x01 1 0 0 0 ; Push memory address of result
|
||
#x02 ; Store fib(n)
|
||
#xff ; Exit program
|
||
))
|
||
|
||
|
||
;;; 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))
|
||
(vm-load-program! my-vm adder-program-bytecode)
|
||
(vm-pc-set! my-vm 5)
|
||
((my-vm 'vm-run))
|
||
(assert-equal 3 (vm-memory-ref my-vm 1)))
|
||
(define-test "fib"
|
||
(define my-vm (make-vm))
|
||
(vm-load-program! my-vm fib-program-bytecode)
|
||
(vm-memory-set! my-vm 1 10)
|
||
(vm-pc-set! my-vm 5)
|
||
((my-vm 'vm-run))
|
||
(assert-equal 55 (vm-memory-ref my-vm 1))))
|