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

added interpreter again

Browse Source
This commit is contained in:
mRnea
2024-08-09 15:01:12 +03:00
parent e7b5f4fec7
commit 9f9956e889
3 changed files with 75 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
cl-forth.asd
View File

@@ -9,6 +9,7 @@
(:file "util")
(:file "assembly")
(:file "cl-forth")
(:file "simulation")
(:file "main")
(:file "test/tests"))
:build-operation "program-op"

4
main.lisp
View File

@@ -13,12 +13,12 @@
;; (format t "~s~%" program)
;; (generate-program program :compile t)))
(generate-program (make-program (second args)) :compile t))
((string= flag "-i")
(interpret-program (make-program (second args))))
((string= flag "-p")
(format t "~a" (make-program (second args))))
((string= flag "-t")
(run-tests))
((string= flag "-s")
(simulate-program (make-program (second args))))
(t (format t "~a is not a valid flag~%" flag))))))
;; (defun make-exe ()

72
simulation.lisp Normal file
View File

@@ -0,0 +1,72 @@
(in-package :cl-forth)
(defvar *stack* ())
(defvar *bel* nil)
(defun simulate-program (program)
(setf *stack* ())
(setf *bel* (make-array 1000 :element-type '(unsigned-byte 8)))
(iter (with op = nil)
(for i below (length program))
(setf op (aref program i))
;; (print op)
;; (print *stack*)
(case (car op)
(:push-int (push (cadr op) *stack*))
(:+ (push (+ (pop *stack*) (pop *stack*)) *stack*))
(:dump (format t "~a~%" (pop *stack*)))
(:= (push (if (= (pop *stack*) (pop *stack*)) 1 0)
*stack*))
(:eş (let ((top (pop *stack*)))
(push top *stack*)
(push top *stack*)))
(:ise (when (= 0 (pop *stack*))
(setf i (cadr op))))
(:yoksa (setf i (cadr op)))
(:yap (if (= 3 (length op))
(setf i (third op))))
(:< (let ((top (pop *stack*)))
(push (if (< (pop *stack*) top) 1 0)
*stack*)))
(:iken (when (= 0 (pop *stack*))
(setf i (cadr op))))
(:bel (push 0 *stack*))
(:oku (push (aref *bel* (pop *stack*)) *stack*))
(:yaz (let ((top (pop *stack*)))
(setf (aref *bel* (pop *stack*)) top)))
(:syscall (let ((fn (pop *stack*)))
(case fn
(1 (let* ((len (pop *stack*))
(start (pop *stack*))
(file-desc (pop *stack*)))
(declare (ignore file-desc))
(princ (map 'string #'code-char
(subseq *bel* start (+ len start))))))
(60 (return-from simulate-program)))))
(:pipe (let ((top (pop *stack*)))
(push (logior (pop *stack*) top) *stack*)))
(:<< (let ((top (pop *stack*)))
(push (ash (pop *stack*) top) *stack*)))
(:>> (let ((top (pop *stack*)))
(push (ash (pop *stack*) (- top)) *stack*)))
(:& (let ((top (pop *stack*)))
(push (logand (pop *stack*) top) *stack*)) )
(:düş (pop *stack*))
(:değiş (let* ((top1 (pop *stack*))
(top2 (pop *stack*)))
(push top1 *stack*)
(push top2 *stack*)))
(:rot (let* ((top1 (pop *stack*))
(top2 (pop *stack*))
(top3 (pop *stack*)))
(push top2 *stack*)
(push top1 *stack*)
(push top3 *stack*)))
(:üst (let* ((top1 (pop *stack*))
(top2 (pop *stack*)))
(push top2 *stack*)
(push top1 *stack*)
(push top2 *stack*))))))
(defun str->prog (str)
(parse-tokens (lex-string str)))