added bit shifts (<< >>), bitand (&), bitor (|), rot, over, swap ops

2 files changed, 63 insertions, 5 deletions

diff --git a/assembly.lisp b/assembly.lisp
index 1ddd326..e4582de 100644
--- a/assembly.lisp
+++ b/assembly.lisp
@@ -147,6 +147,58 @@
         (:write ("pop ~a" (aref call-regs i)))
         (finally (:write "syscall"))))
 
+;;; (rbx rax -- rbx rax rbx)
+(defop üst ()
+  "pop rax"
+  "pop rbx"
+  "push rbx"
+  "push rax"
+  "push rbx")
+
+;;; (rcx rbx rax -- rbx rax rcx)
+(defop rot ()
+  "pop rax"
+  "pop rbx"
+  "pop rcx"
+  "push rbx"
+  "push rax"
+  "push rcx")
+
+;;; (rbx rax -- rax rbx)
+(defop değiş ()
+  "pop rax"
+  "pop rbx"
+  "push rax"
+  "push rbx")
+
+;;; (rbx rcx -- (:shl rbx cl))
+(defop << ()
+  "pop rcx"
+  "pop rbx"
+  "shl rbx, cl"
+  "push rbx")
+
+;;; (rbx rcx -- (:shr rbx cl))
+(defop >> ()
+  "pop rcx"
+  "pop rbx"
+  "shr rbx, cl"
+  "push rbx")
+
+;;; (rbx rcx -- (:or rbx cl))
+(defop "|" ()
+  "pop rax"
+  "pop rbx"
+  "or rbx, rax"
+  "push rbx")
+
+;;; (rbx rcx -- (:and rbx cl))
+(defop & ()
+  "pop rax"
+  "pop rbx"
+  "and rbx, rax"
+  "push rbx")
+
 (defun gen-header (op str)
   (format str "    ;; -- ~s --~%" op))
 
diff --git a/cl-forth.lisp b/cl-forth.lisp
index 4c5eaaf..ab2da73 100644
--- a/cl-forth.lisp
+++ b/cl-forth.lisp
@@ -4,10 +4,17 @@
   (defparameter *identifiers*
     '(+ - dump = ise yoksa yap eş push değiş üst rot düş döngü iken < >
       syscall-1 syscall-2 syscall-3 syscall-4 syscall-5 syscall-6
-      bel oku yaz))
+      bel oku yaz >> << & "|"))
   (defun is-identifier (sym)
     (find sym *identifiers* :test #'string=)))
 
+(defun assembly-undefined-ops ()
+  (iter (for (k) in-hashtable *operations*)
+        (collect k into defops)
+        (finally (return (remove-if (lambda (sym) (search "SYSCALL" (string sym)))
+                                    (set-difference *identifiers* defops
+                                                    :test #'string=))))))
+
 (defun make-token (sym? line col)
   (if (or (numberp sym?) (is-identifier sym?))
       (values (list sym? :line line :col col) nil)
@@ -27,6 +34,9 @@
           (cond ;; ((char= #\. next-char)
             ;;  (collect (make-token '|.| line-num col) into tokens)
             ;;  (read-char line-stream))
+            ((char= #\|  next-char)
+             (read-char line-stream)
+             (collect (make-token "|" line-num col) into tokens))
             ((char= #\Space next-char) (read-char line-stream))
             ((char= #\; next-char) ;; and not in string
              (finish))
@@ -246,8 +256,4 @@
 (defun compile-program (path)
   (generate-program (make-program path) :compile t))
 
-(defun assembly-undefined-ops ()
-  (iter (for (k) in-hashtable *operations*)
-        (collect k into defops)
-        (finally (return (set-difference *identifiers* defops)))))