108 lines
2.7 KiB
Common Lisp
108 lines
2.7 KiB
Common Lisp
(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 (&key (indent 4) args) &body asm-strings)
|
|
`(setf (gethash ',op-name *operations*)
|
|
(lambda (out-stream ,@args)
|
|
(format out-stream
|
|
,(format nil "~~{~a~~a~~%~~}"
|
|
(make-string indent :initial-element
|
|
#\Space))
|
|
,(normalize-op-list asm-strings)))))
|
|
|
|
|
|
(defop push (:args (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")
|
|
|
|
(defop = ()
|
|
"mov rcx, 0"
|
|
"mov rdx, 1"
|
|
"pop rax"
|
|
"pop rbx"
|
|
"cmp rax, rbx"
|
|
"cmove rcx, rdx"
|
|
"push rcx")
|
|
|
|
(defop exit (:args (exit-code))
|
|
"mov rax, 60"
|
|
("mov rdi, ~a" exit-code)
|
|
"syscall")
|
|
|
|
(defop ise (:args (label-num))
|
|
"pop rax"
|
|
"test rax, rax"
|
|
("jz et_~a" label-num))
|
|
|
|
(defop yoksa (:args (yap-num ise-num) :indent 0)
|
|
(" jmp et_~a" yap-num)
|
|
("et_~a:" ise-num))
|
|
|
|
(defop yap (:args (label-num) :indent 0)
|
|
("et_~a:" label-num))
|
|
|
|
(defun gen-code (op str)
|
|
(let ((op-fn (gethash (car op) *operations*)))
|
|
(if (null op-fn)
|
|
(error "~s is not a valid op" op)
|
|
(apply op-fn str (cdr op)))))
|
|
|
|
(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")))
|