(in-package :cl-forth)

(defparameter *operations* (make-hash-table))

(eval-always
  (defun normalize-op-list (lst)
    (cons 'list
          (mapcar (lambda (el) (cond ((stringp el) el)
                                ((listp el) `(format nil ,@el))))
                  lst))))

(defmacro defop (op-name args &body asm-strings)
  `(setf (gethash ',op-name *operations*)
         (lambda (out-stream ,@args)
           (format out-stream "~{    ~a~%~}"
                   ,(normalize-op-list asm-strings)))))


(defop push (a)
  ("push ~d" a))

(defop + ()
  "pop rax"
  "pop rbx"
  "add rax, rbx"
  "push rax")

(defop - ()
  "pop rax"
  "pop rbx"
  "sub rbx, rax"
  "push rbx")

(defop |.| ()
  "pop rdi"
  "call dump")

(defun gen-dump (str)
  (format str "~{~a~%~}"
          '("dump:"
            "    mov     r9, -3689348814741910323"
            "    sub     rsp, 40"
            "    mov     BYTE [rsp+31], 10"
            "    lea     rcx, [rsp+30]"
            ".L2:"
            "    mov     rax, rdi"
            "    lea     r8, [rsp+32]"
            "    mul     r9"
            "    mov     rax, rdi"
            "    sub     r8, rcx"
            "    shr     rdx, 3"
            "    lea     rsi, [rdx+rdx*4]"
            "    add     rsi, rsi"
            "    sub     rax, rsi"
            "    add     eax, 48"
            "    mov     BYTE [rcx], al"
            "    mov     rax, rdi"
            "    mov     rdi, rdx"
            "    mov     rdx, rcx"
            "    sub     rcx, 1"
            "    cmp     rax, 9"
            "    ja      .L2"
            "    lea     rax, [rsp+32]"
            "    mov     edi, 1"
            "    sub     rdx, rax"
            "    xor     eax, eax"
            "    lea     rsi, [rsp+32+rdx]"
            "    mov     rdx, r8"
            "    mov     rax, 1"
            "    syscall"
            "    add     rsp, 40"
            "    ret")))