(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))
    (with-output-to-port out (lambda () (assemble adder-program-asm)))
    (assert-equal adder-program-bytecode (get-output-bytevector out)))
  (define-test "fib"
    (define out (open-output-bytevector))
    (with-output-to-port out (lambda () (assemble fib-program-asm)))
    (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))))