simyager/kurt
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added ops for C codegen

Browse Source
This commit is contained in:
mRnea
2024-08-09 11:41:14 +03:00
parent 1056b74b11
commit b574944656
3 changed files with 99 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
assembly.lisp
View File

@@ -149,7 +149,10 @@
,(cons 'list
(c-stack->string (car forms))))))
(:string `((defop-format ,out-stream ,indent
,(normalize-op-list forms)))))))
,(normalize-op-list forms))))
(:general `((progn ,@(mapcar (lambda (form) (replace-write out-stream indent
form))
forms)))))))
(defun expand-c (out-stream indent body)
(mapcan #'(lambda (group) (expand-c-group group out-stream :indent indent))
@@ -192,20 +195,20 @@
(multiple-value-bind (prev next) (split-stack stack)
(let ((*print-case* :downcase))
(append (iter (for x in (reverse prev))
(collect (format nil "~a = pop(&stack);" x)))
(collect (format nil "~a = pop();" x)))
(iter (for x in next)
(if (and (consp x) (assoc (car x) *c-ops*))
(destructuring-bind (op arg1 arg2 . conds) x
(let ((opstr (cadr (assoc op *c-ops*))))
(if (null conds)
(collect (format nil "push(&stack, ~a ~a ~a);"
(collect (format nil "push(~a ~a ~a);"
arg1 opstr (not-cl arg2)))
(collect (format nil
"push(&stack, (~a ~a ~a) ? ~a : ~a);"
"push((~a ~a ~a) ? ~a : ~a);"
arg1 opstr (not-cl arg2)
(getf conds :ise)
(getf conds :değilse))))))
(collect (format nil "push(&stack, ~a);" x)))))))))
(collect (format nil "push(~a);" x)))))))))
(defun comment-safe-str (str)
"Handle newlines for comment"
@@ -395,10 +398,85 @@
;;; C operations
(defop (push-int a) (:lex nil :targets :c)
("push(&stack, ~d);" a))
("push(~d);" a))
;; (defop (push-str a) (:lex nil :targets :c)
;; ("push(&stack, ~d);" a))
(defop dump (:targets :c)
("printf(\"%d\\n\", pop(&stack));"))
("printf(\"%d\\n\", pop());"))
(defop (ise label-num) (:targets :c)
"rax = pop();"
("if(!rax){ goto et_~a; }" label-num))
(defop (yoksa yap-num ise-num) (:indent 0 :targets :c)
(" goto et_~a;" yap-num)
("et_~a:" ise-num))
(defop (yap label-num &optional döngü-num) (:indent 0 :targets :c)
(if (null döngü-num)
(:write ("et_~a:" label-num))
(:write (" goto et_~a;" döngü-num)
("et_~a:" label-num))))
(defop (iken label-num) (:targets :c)
"rax = pop();"
("if(!rax){ goto et_~a; }" label-num))
(defop (döngü label-num) (:indent 0 :targets :c)
("et_~a:" label-num))
(defop bel (:targets :c)
"push((uintptr_t) bel);")
(defop oku (:targets :c)
"push(*((char*) pop()));")
(defop yaz (:targets :c)
"rax = pop();"
"*((char*) pop()) = rax;")
(defop (syscall num) (:lex nil :targets :c)
(iter (with call-regs = #("rdi" "rsi" "rdx" "r10" "r8" "r9"))
(initially (:write "rax = pop();"))
(for i from (- num 1) downto 0)
(:write ("~a = pop();" (aref call-regs i)))
(collect (aref call-regs i) into used-regs)
(finally (:write ("syscall(rax~{, ~a~});" (reverse used-regs))))))
(defun gen-c-stack (stream)
(format stream "~{~a~%~}"
'("#include <stdio.h>"
"#include <stdint.h>"
""
"struct Stack {"
" uintptr_t content[1000000];"
" int i;"
"};"
""
"typedef struct Stack Stack;"
""
"Stack stack = { .i = 0 };"
""
"void push(uintptr_t val){"
" stack.content[stack.i] = val;"
" stack.i += 1;"
"}"
""
"uintptr_t pop(){"
" stack.i -= 1;"
" return stack.content[stack.i];"
"}"
""
"uintptr_t rax, rbx, rcx, rdi, rsi, rdx, r10, r8, r9;"
"char bel[640000];"
"")))
(defmacro with-c-fn ((ret name) args out &body body)
`(let ((*print-case* :downcase))
(format ,out "~a ~a(~{~a ~a~^, ~}){~%" ',ret ',name ',args)
,@body
(format ,out "~&}~%")))