diff options
| -rw-r--r-- | README.org | 17 | ||||
| -rw-r--r-- | assembly.lisp | 29 | ||||
| -rw-r--r-- | cl-forth.lisp | 23 |
3 files changed, 57 insertions, 12 deletions
@@ -5,11 +5,18 @@ Tsoding'in Porth (Forth in Python) serisinden esinlenme. [[https://www.youtube.com/playlist?list=PLpM-Dvs8t0VbMZA7wW9aR3EtBqe2kinu4][Porth playlist]] [[https://gitlab.com/tsoding/porth][gitlab]] +* Kurulum + +* Örnekler + * Yol Haritası -koşullu dallanma (if) -döngüler ++ koşullu dallanma (if) ++ döngüler fonksiyon tanımı -string literal ++ string literal +static typing (belki) +windows ve macos desteği + +* Kaynak +[[https://concatenative.org/wiki/][Concatenative languages]] -* readme TODO -örnek ekle vb. diff --git a/assembly.lisp b/assembly.lisp index e872ee8..c1efe45 100644 --- a/assembly.lisp +++ b/assembly.lisp @@ -127,9 +127,14 @@ ;;; Hopefully these two are done, need testing... ;; ( -- a) -(defop (push a) (:lex nil) +(defop (push-int a) (:lex nil) ("push ~d" a)) +(defop (push-str len addr str) (:lex nil) + (progn (:write ("push ~d" len) + ("push str_~d" addr)) + (list :string addr str))) + (defop + () (rbx rax -- (:add rax rbx))) @@ -236,14 +241,28 @@ (:write ("pop ~a" (aref call-regs i))) (finally (:write "syscall")))) +(defun comment-safe-str (str) + "Handle newlines for asm comment" + (with-output-to-string (new-str) + (iter (for ch in-string str with-index i) + (cond ((> i 10) + (princ "..." new-str) + (finish)) + ((char= #\Newline ch) + (princ "\\n" new-str)) + (t (write-char ch new-str)))))) + (defun gen-header (op str) - (format str " ;; -- ~s --~%" op)) + (format str " ;; -- ~s --~%" + (mapcar (lambda (x) (if (stringp x) (comment-safe-str x) x)) + op))) (defun gen-code (op str) (let ((op-fn (gethash (string (car op)) *operations*))) - (if (null op-fn) - (error "~s is not a valid op" op) - (apply op-fn str (cdr op))))) + (when (null op-fn) + (error "~s is not a valid op" op)) + (gen-header op str) + (apply op-fn str (cdr op)))) (defun gen-dump (str) (format str "~{~a~%~}" diff --git a/cl-forth.lisp b/cl-forth.lisp index 7cee812..d935956 100644 --- a/cl-forth.lisp +++ b/cl-forth.lisp @@ -1,7 +1,7 @@ (in-package :cl-forth) (defun make-token (sym? line col) - (if (or (numberp sym?) (is-identifier sym?)) + (if (or (numberp sym?) (stringp sym?) (is-identifier sym?)) (values (list sym? :line line :col col) nil) (values (list sym? :line line :col col :error t) t))) @@ -9,6 +9,17 @@ (car token)) ;;; LEXER +(defun read-string (stream) + ;; TODO: Handle unmatched " and give proper error message + (with-output-to-string (str) + (iter (for ch = (read-char stream)) + (cond ((char= ch #\") + (finish)) + ((and (char= ch #\\) (char= (peek-char nil stream) #\n)) + (read-char stream) + (write-char #\Newline str)) + (t (write-char ch str)))))) + (defun lex-line (line &optional (line-num 0)) (iter (with line-stream = (make-string-input-stream line)) (with col = 0) @@ -25,6 +36,11 @@ ((char= #\Space next-char) (read-char line-stream)) ((char= #\; next-char) ;; and not in string (finish)) + ((char= #\" next-char) + (read-char line-stream) + (collect (make-token (read-string line-stream) + line-num col) + into tokens)) (t (setf flag nil))) (when flag (incf col) @@ -95,7 +111,10 @@ (for token in tokens) (let ((op (token-op token))) (cond ((numberp op) - (vector-push-extend `(push ,op) ops)) + (vector-push-extend `(push-int ,op) ops)) + ((stringp op) + (vector-push-extend `(push-str ,(length op) ,i ,op) + ops)) ((string= 'ise op) (push (list 'ise i) stack) (vector-push-extend (list 'ise nil) ops)) |