scm-to-vm/tests.scm

(use-modules (d- test)
	     (scmvm assembler)
             (scmvm vm forth)
             (scmvm util stack)
	     (scmvm debugger)
	     (scmvm language assembly)
	     (scmvm language scheme)
             (rnrs bytevectors)
             (rnrs io ports)
             ((scheme base)
              #:select (open-output-bytevector get-output-bytevector)))

;;; Data
(define adder-program-assembly
  '((variable result 0)
    (push 1)
    (push 2)
    (+)
    (push result)
    (!)
    (bye)))

(define fib-program-assembly
  '(  (variable result 0)
      (ref result)
      (push fib)
      (call)
      (push cleanup)
      (jmp)
    fib
      (dup)
      (push 0)
      (=)
      (over)
      (push 1)
      (=)
      (or)
      (push recur)
      (if)
      (return)
    recur
      (dup)
      (push 1)
      (-)
      (push fib)
      (call)
      (over)
      (push 2)
      (-)
      (push fib)
      (call)
      (+)
      (nip)
      (return)
    cleanup
      (set! 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 "assembly"
  (define-test "adder"
    (define out (open-output-bytevector))
    (assemble adder-program-assembly forth-instruction-set out)
    (assert-equal adder-program-bytecode (get-output-bytevector out)))
  (define-test "fib"
    (define out (open-output-bytevector))
    (assemble fib-program-assembly forth-instruction-set out)
    (assert-equal fib-program-bytecode (get-output-bytevector out))))

(define-test-suite "vm"
  (define-test "adder"
    (define my-vm (make-forth-vm forth-instruction-set))
    (forth-vm-load-program! my-vm adder-program-bytecode)
    (forth-vm-pc-set! my-vm 5)
    (forth-vm-run! my-vm)
    (assert-equal 3 (forth-vm-memory-ref my-vm 1)))
  (define-test "fib"
    (define my-vm (make-forth-vm forth-instruction-set))
    (forth-vm-load-program! my-vm fib-program-bytecode)
    (forth-vm-memory-set! my-vm 1 10)
    (forth-vm-pc-set! my-vm 5)
    (forth-vm-run! my-vm)
    (assert-equal 55 (forth-vm-memory-ref my-vm 1))))

(define-test-suite "debugger"
  (define-test "modify-running-program"
    (define fib-program-asm (make-assembler forth-instruction-set))
    (assemble-instructions! fib-program-asm fib-program-assembly)
    (assembler-backpatch! fib-program-asm)
    (define my-debugger (make-forth-debugger fib-program-asm))
    (define my-vm (debugger-vm my-debugger))
    (define my-data (forth-vm-data-stack my-vm))
    (forth-vm-memory-set! my-vm 1 10)
    (forth-vm-pc-set! my-vm 5)
    (debugger-breakpoint-add! my-debugger 'fib)
    (debugger-continue my-debugger)
    (assert-equal 10 (stack-peek my-data))
    (stack-pop my-data)
    (stack-push my-data 1)
    (debugger-continue my-debugger)
    (assert-equal 1 (forth-vm-memory-ref my-vm 1)))
  (define-test "stepping"
    (define fib-program-asm (make-assembler forth-instruction-set))
    (assemble-instructions! fib-program-asm fib-program-assembly)
    (assembler-backpatch! fib-program-asm)
    (define my-debugger (make-forth-debugger fib-program-asm))
    (define my-vm (debugger-vm my-debugger))
    (forth-vm-memory-set! my-vm 1 10)
    (forth-vm-pc-set! my-vm 5)
    (debugger-breakpoint-add! my-debugger 'fib)
    (debugger-continue my-debugger)
    (assert-equal 23 (forth-vm-pc my-vm))
    (debugger-step my-debugger)
    (assert-equal 24 (forth-vm-pc my-vm)) ;; dup is a 1 byte instruction
    (debugger-step my-debugger)
    (assert-equal 29 (forth-vm-pc my-vm)) ;; push is a 5 byte instruction
    (debugger-continue my-debugger)
    (assert-equal 23 (forth-vm-pc my-vm)) ;; continue stops stepping
    ))