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

further fixes, probably need to change representation of tokens

Browse Source
This commit is contained in:
mRnea
2024-07-29 23:56:06 +03:00
parent 004c2b5628
commit 4091b0e81f
1 changed files with 10 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
cl-forth.lisp
View File

@@ -48,7 +48,7 @@
(defun lex-file (file-name &optional report-errors) (defun lex-file (file-name &optional report-errors)
(let ((has-error nil)) (let ((has-error nil))
(values (values
(with-open-file (str file-name) (with-open-file (str file-name :external-format :utf-8)
(iter outer (iter outer
(for line = (read-line str nil nil)) (for line = (read-line str nil nil))
(until (null line)) (until (null line))
@@ -99,30 +99,30 @@
(let ((op (token-op token))) (let ((op (token-op token)))
(cond ((numberp op) (cond ((numberp op)
(vector-push-extend `(push ,op) ops)) (vector-push-extend `(push ,op) ops))
((eq 'ise op) ((string= 'ise op)
(push (list 'ise i) stack) (push (list 'ise i) stack)
(vector-push-extend (list 'ise nil) ops)) (vector-push-extend (list 'ise nil) ops))
((eq 'yoksa op) ((string= 'yoksa op)
(let ((top (pop stack))) (let ((top (pop stack)))
(assert (eq 'ise (car top))) (assert (string= 'ise (car top)))
(setf (second (aref ops (cadr top))) i) (setf (second (aref ops (cadr top))) i)
(push (list 'yoksa i) stack) (push (list 'yoksa i) stack)
(vector-push-extend (list 'yoksa nil i) ops))) (vector-push-extend (list 'yoksa nil i) ops)))
((eq 'yap op) ((string= 'yap op)
(let ((top (pop stack))) (let ((top (pop stack)))
(cond ((find (car top) (list 'yoksa 'ise)) (cond ((find (car top) (list 'yoksa 'ise))
(setf (second (aref ops (cadr top))) i) (setf (second (aref ops (cadr top))) i)
(vector-push-extend (list 'yap i) ops)) (vector-push-extend (list 'yap i) ops))
((eq 'iken (car top)) ((string= 'iken (car top))
(setf (second (aref ops (cadr top))) i) (setf (second (aref ops (cadr top))) i)
(vector-push-extend (list 'yap i (third top)) ops)) (vector-push-extend (list 'yap i (third top)) ops))
(t (error "yap cannot reference: ~a" (car top)))))) (t (error "yap cannot reference: ~a" (car top))))))
((eq 'döngü op) ((string= 'döngü op)
(push (list 'döngü i) stack) (push (list 'döngü i) stack)
(vector-push-extend (list 'döngü i) ops)) (vector-push-extend (list 'döngü i) ops))
((eq 'iken op) ((string= 'iken op)
(let ((top (pop stack))) (let ((top (pop stack)))
(assert (eq 'döngü (car top))) (assert (string= 'döngü (car top)))
(push (list 'iken i (cadr top)) stack) (push (list 'iken i (cadr top)) stack)
(vector-push-extend (list 'iken nil) ops))) (vector-push-extend (list 'iken nil) ops)))
((search "syscall" (string-downcase (string op))) ((search "syscall" (string-downcase (string op)))
@@ -219,7 +219,7 @@
;;; COMPILER ;;; COMPILER
(defun write-program (program out &key mem-cap) (defun write-program (program out &key (mem-cap 640000))
(format out "~a~%" "segment .text") (format out "~a~%" "segment .text")
(gen-dump out) (gen-dump out)
(format out "~{~a~%~}" '("global _start" (format out "~{~a~%~}" '("global _start"