diff options
-rw-r--r-- | cl-forth.lisp | 30 | ||||
-rw-r--r-- | main.lisp | 2 | ||||
-rw-r--r-- | util.lisp | 4 |
3 files changed, 20 insertions, 16 deletions
diff --git a/cl-forth.lisp b/cl-forth.lisp index 9d66532..e4b166c 100644 --- a/cl-forth.lisp +++ b/cl-forth.lisp @@ -197,25 +197,29 @@ ;;; COMPILER +(defun write-program (program out &key mem-cap) + (format out "~a~%" "segment .text") + (gen-dump out) + (format out "~{~a~%~}" '("global _start" + "_start:")) + (iter (for op in-sequence program) + (gen-header op out) + (gen-code op out)) + (gen-header '(exit 0) out) + (gen-code '(exit 0) out) + (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)) (with-open-file (out path :direction :output :if-exists :supersede) - (format out "~a~%" "segment .text") - (gen-dump out) - (format out "~{~a~%~}" '("global _start" - "_start:")) - (iter (for op in-sequence program) - (gen-header op out) - (gen-code op out)) - (gen-header '(exit 0) out) - (gen-code '(exit 0) out) - (format out "~a~%" "segment .bss") - (format out "~a ~a~%" "bel: resb" mem-cap)) + (write-program program out :mem-cap mem-cap)) (when compile - (run `("nasm" "-felf64" ,path)) + (run `("nasm" "-felf64" ,path) :output t) (let ((name (first (uiop:split-string path :separator '(#\.))))) - (run `("ld" "-o" ,name ,(concatenate 'string name ".o")))))) + (run `("ld" "-o" ,name ,(concatenate 'string name ".o")) + :output t)))) (defun compile-program (path) (generate-program (make-program path) :compile t)) @@ -39,7 +39,7 @@ (defun example-run () (example-compile) - (run '("test/output"))) + (run '("test/output") :output t)) (defun start-forth-repl () (iter (for line = (progn (format t "~&> ") (read-line))) @@ -20,9 +20,9 @@ (defun mklist (form) (if (listp form) form (list form))) -(defun run (args) +(defun run (args &rest options) (format t "~{~a~^ ~}~%" args) - (uiop:run-program args :output *standard-output*)) + (apply #'uiop:run-program args options)) (defun from-root (path) (merge-pathnames path (asdf:system-source-directory :cl-forth))) |