From 1056b74b115f2a0a5cdb6b05fffc6eb476fb1f3c Mon Sep 17 00:00:00 2001
From: mRnea <akannemre@gmail.com>
Date: Thu, 8 Aug 2024 17:13:29 +0300
Subject: Begin C code generation.

---
 cl-forth.lisp | 83 +++++++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 63 insertions(+), 20 deletions(-)

(limited to 'cl-forth.lisp')

diff --git a/cl-forth.lisp b/cl-forth.lisp
index ec7927f..66327e5 100644
--- a/cl-forth.lisp
+++ b/cl-forth.lisp
@@ -164,38 +164,81 @@
     (parse-tokens tokens)))
 
 ;;; COMPILER
-(defun write-program (program out &key (mem-cap 640000))
+;;(defgeneric write-program (target program stream))
+(defmethod write-program ((target (eql :nasm)) program out
+                          &key (mem-cap 640000))
   (format out "~a~%" "segment .text")
   (gen-dump out)
   (format out "~{~a~%~}" '("global _start"
                            "_start:"))
   (let ((strs nil))
     (iter (for op in-sequence program)
-          (let ((gen-val (gen-code op out)))
+          (let ((gen-val (write-op target out (car op) (cdr op))))
             (when (and (consp gen-val) (eq :string (car gen-val)))
               (push (cdr gen-val) strs))))
-         (gen-code '(:exit 0) out)
-         (unless (null strs)
-           (format out "segment .data~%")
-           (dolist (str strs)
-             (format out "str_~a: db ~{0x~x~^,~}~%"
-                     (first str)
-                     (map 'list #'char-code (second str))))))
+    (write-op target out :exit '(0))
+    (unless (null strs)
+      (format out "segment .data~%")
+      (dolist (str strs)
+        (format out "str_~a: db ~{0x~x~^,~}~%"
+                (first str)
+                (map 'list #'char-code (second str))))))
   (format out "~a~%" "segment .bss")
   (format out "~a ~a~%" "bel: resb" mem-cap))
 
-(defun generate-program (program &key (path "output.asm") (compile nil)
-                                   (mem-cap 640000) (silence nil))
-  (with-open-file (out path :direction :output
-                            :if-exists :supersede)
-    (write-program program out :mem-cap mem-cap))
+(defmethod write-program ((target (eql :c)) program out &key (mem-cap 640000))
+  (declare (ignore mem-cap))
+  (format out
+          "#include <stdio.h>
+
+struct Stack {
+    int content[100];
+    int i;
+};
+
+typedef struct Stack Stack;
+
+void push(Stack* stack, int val){
+    stack->content[stack->i] = val;
+    stack->i += 1;
+}
+
+int pop(Stack* stack){
+    stack->i -= 1;
+    return stack->content[stack->i];
+}
+
+Stack stack;
+int rax, rbx;
+
+int main(void){
+    stack.i = 0;
+")
+  (iter (for op in-sequence program)
+        (write-op target out (car op) (cdr op)))
+  (format out "    return 0;~%}~%"))
+
+(defun generate-program (program
+                         &key (path "output.asm") (compile nil)
+                           (mem-cap 640000) (silence nil) (target :nasm))
+  (with-open-file (out path :direction :output :if-exists :supersede)
+    (write-program target program out :mem-cap mem-cap))
   (when compile
-    (run `("nasm" "-felf64" ,path) :output t :silence silence)
-    (let ((name (first (uiop:split-string path :separator '(#\.)))))
-      (run `("ld" "-o" ,name ,(concatenate 'string name ".o"))
-           :output t :silence silence))))
+    (compile-program target path silence)))
+
+(defgeneric compile-program (target path silence))
+(setf (documentation #'compile-program 'function)
+      (format nil "Produces the executable from source code, targets are ~a"
+              *targets*))
+
+(defmethod compile-program ((target (eql :nasm)) path silence)
+  (run `("nasm" "-felf64" ,path) :output t :silence silence)
+  (let ((name (first (uiop:split-string path :separator '(#\.)))))
+    (run `("ld" "-o" ,name ,(concatenate 'string name ".o"))
+         :output t :silence silence)))
+
+(defmethod compile-program ((target (eql :c)) path silence)
+  (run `("gcc" ,path) :output t :silence silence))
 
-(defun compile-program (path)
-  (generate-program (make-program path) :compile t))
 
 
-- 
cgit v1.2.3