From 025c958e2f8b1499f23a5ae1c1be23452572b326 Mon Sep 17 00:00:00 2001 From: mRnea Date: Wed, 24 Jul 2024 12:09:26 +0300 Subject: branching (if else) added, as interpretation and compilation --- cl-forth.lisp | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) (limited to 'cl-forth.lisp') diff --git a/cl-forth.lisp b/cl-forth.lisp index 14b6573..f7ea66e 100644 --- a/cl-forth.lisp +++ b/cl-forth.lisp @@ -74,16 +74,24 @@ (defun parse-tokens (tokens) (iter (with ops = (make-array (length tokens) :fill-pointer 0 :adjustable t)) + (with if-stack = ()) (for i from 0) (for token in tokens) (let ((op (token-op token))) (cond ((numberp op) (vector-push-extend `(push ,op) ops)) ((eq 'ise op) - (vector-push-extend - `(ise ,(position 'yap tokens :start i :key #'token-op)) - ops)) - ;; currently does not handle nesting + (push i if-stack) + (vector-push-extend (list 'ise nil) ops)) + ((eq 'yoksa op) + (let ((current (pop if-stack))) + (setf (second (aref ops current)) i) + (push i if-stack) + (vector-push-extend (list 'yoksa nil i) ops))) + ((eq 'yap op) + (let ((current (pop if-stack))) + (setf (second (aref ops current)) i) + (vector-push-extend (list 'yap i) ops))) (t (vector-push-extend (list op) ops)))) (finally (return ops)))) @@ -141,6 +149,7 @@ 1 0) stack)) (yap (next-iteration)) + (yoksa (setf i (second op))) (ise (if (= (vector-pop stack) 1) nil (setf i (second op)))) @@ -184,13 +193,8 @@ "_start:")) (iter (for op in-sequence program) (gen-header op out) - (let ((op-fn (gethash (car op) *operations*))) - (if (null op-fn) - (format t "~s is not an op" (car op)) - (apply op-fn out (cdr op))))) - (format out "~{~a~%~}" '(" mov rax, 60" - " mov rdi, 0" - " syscall"))) + (gen-code op out)) + (gen-code '(exit 0) out)) (when compile (run `("nasm" "-felf64" ,path)) (let ((name (first (uiop:split-string path :separator '(#\.))))) -- cgit v1.2.3