(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)
      (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 "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))))