From a0fb419b1be8ed53f580c509b7a55cde8e06d4c9 Mon Sep 17 00:00:00 2001
From: mRnea <akannemre@gmail.com>
Date: Thu, 18 Jul 2024 13:50:14 +0300
Subject: =?UTF-8?q?ba=C5=9Flang=C4=B1=C3=A7,=20push=20pop=20+=20-=20.=20vb?=
 =?UTF-8?q?.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 assembly.lisp | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)
 create mode 100644 assembly.lisp

(limited to 'assembly.lisp')

diff --git a/assembly.lisp b/assembly.lisp
new file mode 100644
index 0000000..3e80686
--- /dev/null
+++ b/assembly.lisp
@@ -0,0 +1,72 @@
+(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")))
-- 
cgit v1.2.3