94 lines
3.6 KiB
Common Lisp
94 lines
3.6 KiB
Common Lisp
(in-package :kurt)
|
|
|
|
(defvar *stack* nil)
|
|
(defvar *bel* nil)
|
|
|
|
(defmacro push* (item)
|
|
`(vector-push ,item *stack*))
|
|
|
|
(defmacro pop* ()
|
|
`(the fixnum (vector-pop *stack*)))
|
|
|
|
(defun simulate-program (program)
|
|
(declare (optimize (speed 3)) (vector program))
|
|
(let ((*bel* (make-array 1000 :element-type '(unsigned-byte 8)))
|
|
(*stack* (make-array 1000 :element-type 'fixnum :fill-pointer 0)))
|
|
(iter (with op = nil)
|
|
(for i below (the fixnum (length program)))
|
|
(declare (fixnum i))
|
|
(setf op (aref program i))
|
|
;; (print op)
|
|
;; (print *stack*)
|
|
(case (car op)
|
|
(:divmod (let ((top (pop*)))
|
|
(multiple-value-bind (div mod) (truncate (pop*) top)
|
|
(push* div)
|
|
(push* mod))))
|
|
(:push-int (push* (cadr op)))
|
|
(:+ (push* (+ (pop*) (pop*))))
|
|
(:- (let ((top (pop*)))
|
|
(push* (- (pop*) top))))
|
|
(:* (push* (* (pop*) (pop*))))
|
|
(:dump (format t "~a~%" (pop*)))
|
|
(:= (push* (if (= (pop*) (pop*)) 1 0)))
|
|
(:eş (let ((top (pop*)))
|
|
(push* top)
|
|
(push* top)))
|
|
(:ise (when (= 0 (pop*))
|
|
(setf i (cadr op))))
|
|
(:yoksa (setf i (cadr op)))
|
|
(:yap (if (= 3 (length op))
|
|
(setf i (third op))))
|
|
(:< (let ((top (pop*)))
|
|
(push* (if (< (pop*) top) 1 0))))
|
|
(:> (let ((top (pop*)))
|
|
(push* (if (> (pop*) top) 1 0))))
|
|
(:iken (when (= 0 (pop*))
|
|
(setf i (cadr op))))
|
|
(:döngü nil)
|
|
(:bel (push* 0))
|
|
(:oku (push* (aref *bel* (pop*))))
|
|
(:yaz (let ((top (pop*)))
|
|
(setf (aref *bel* (pop*)) top)))
|
|
(:syscall (let ((fn (pop*)))
|
|
(case fn
|
|
(1 (let* ((len (pop*))
|
|
(start (pop*))
|
|
(file-desc (pop*)))
|
|
(declare (ignore file-desc))
|
|
;; (princ (map 'string #'code-char
|
|
;; (subseq *bel* start (+ len start))))
|
|
(loop for i from start below (+ len start)
|
|
do (write-char (code-char (aref *bel* i))))
|
|
(fresh-line)))
|
|
(60 (return-from simulate-program)))))
|
|
(:pipe (let ((top (pop*)))
|
|
(push* (logior (pop*) top))))
|
|
(:<< (let ((top (pop*)))
|
|
(push* (ash (pop*) top))))
|
|
(:>> (let ((top (pop*)))
|
|
(push* (ash (pop*) (- top)))))
|
|
(:& (let ((top (pop*)))
|
|
(push* (logand (pop*) top))))
|
|
(:düş (pop*))
|
|
(:değiş (let* ((top1 (pop*))
|
|
(top2 (pop*)))
|
|
(push* top1)
|
|
(push* top2)))
|
|
(:rot (let* ((top1 (pop*))
|
|
(top2 (pop*))
|
|
(top3 (pop*)))
|
|
(push* top2)
|
|
(push* top1)
|
|
(push* top3)))
|
|
(:üst (let* ((top1 (pop*))
|
|
(top2 (pop*)))
|
|
(push* top2)
|
|
(push* top1)
|
|
(push* top2)))
|
|
(otherwise (format t "Unknown keyword: ~a~%" (car op))
|
|
(finish))))))
|
|
|
|
(defun str->prog (str)
|
|
(parse-tokens (lex-string str)))
|