diff options
Diffstat (limited to 'cl-forth.lisp')
| -rw-r--r-- | cl-forth.lisp | 26 |
1 files changed, 15 insertions, 11 deletions
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 '(#\.))))) |