changed . to dump, extended defop syntax, added while loops

assembly.lisp

@@ -3,23 +3,38 @@
 (defparameter *operations* (make-hash-table))
 
 (eval-always
-  (defun normalize-op-list (lst)
+  (defun normalize-op-list (asm-list)
     (cons 'list
           (mapcar (lambda (el) (cond ((stringp el) el)
                                 ((listp el) `(format nil ,@el))))
-                  lst))))
+                  asm-list)))
 
-(defmacro defop (op-name (&key (indent 4) args) &body asm-strings)
-  `(setf (gethash ',op-name *operations*)
-         (lambda (out-stream ,@args)
-           (format out-stream
-                   ,(format nil "~~{~a~~a~~%~~}" 
-                            (make-string indent :initial-element
-                                         #\Space))
-                   ,(normalize-op-list asm-strings)))))
+  (defun defop-format (str space-num asm-list)
+    (format str
+            (format nil "~~{~a~~a~~%~~}" 
+                    (make-string space-num :initial-element #\Space))
+            asm-list))
 
+  (defun replace-write (out-stream indent forms)
+    (if (consp forms)
+        (if (eq :write (car forms))
+            `(defop-format ,out-stream ,indent
+               ,(normalize-op-list (cdr forms)))
+            (cons (replace-write out-stream indent (car forms))
+                  (replace-write out-stream indent (cdr forms))))
+        forms)))
 
-(defop push (:args (a))
+(defmacro defop (op-name+args (&key (indent 4)) &body body)
+  (with-gensyms (out-stream)
+    (destructuring-bind (op-name . args) (mklist op-name+args)
+      `(setf (gethash ',op-name *operations*)
+             (lambda (,out-stream ,@args)
+               ,(if (or (stringp (car body)) (stringp (caar body)))
+                    `(defop-format ,out-stream ,indent
+                              ,(normalize-op-list body))
+                    (replace-write out-stream indent (car body))))))))
+
+(defop (push a) ()
   ("push ~d" a))
 
 (defop + ()
@@ -34,7 +49,7 @@
   "sub rbx, rax"
   "push rbx")
 
-(defop |.| ()
+(defop dump ()
   "pop rdi"
   "call dump")
 
@@ -47,23 +62,60 @@
   "cmove rcx, rdx"
   "push rcx")
 
-(defop exit (:args (exit-code))
+(defop (exit code) ()
   "mov rax, 60"
-  ("mov rdi, ~a" exit-code)
+  ("mov rdi, ~a" code)
   "syscall")
 
-(defop ise (:args (label-num))
+(defop (ise label-num) ()
   "pop rax"
   "test rax, rax"
   ("jz et_~a" label-num))
 
-(defop yoksa (:args (yap-num ise-num) :indent 0)
+(defop (yoksa yap-num ise-num) (:indent 0)
   ("    jmp et_~a" yap-num)
   ("et_~a:" ise-num))
 
-(defop yap (:args (label-num) :indent 0)
+(defop (yap label-num &optional döngü-num) (:indent 0)
+  (if (null döngü-num)
+      (:write ("et_~a:" label-num))
+      (:write ("    jmp et_~a" döngü-num)
+              ("et_~a:" label-num))))
+
+(defop eş ()
+  "pop rax"
+  "push rax"
+  "push rax")
+
+(defop düş ()
+  "pop rax")
+
+(defop (iken label-num) ()
+  "pop rax"
+  "test rax, rax"
+  ("jz et_~a" label-num))
+
+(defop (döngü label-num) (:indent 0)
   ("et_~a:" label-num))
 
+(defop < ()
+  "mov rcx, 0"
+  "mov rdx, 1"
+  "pop rbx"
+  "pop rax"
+  "cmp rax, rbx"
+  "cmovl rcx, rdx"
+  "push rcx")
+
+(defop > ()
+  "mov rcx, 0"
+  "mov rdx, 1"
+  "pop rbx"
+  "pop rax"
+  "cmp rax, rbx"
+  "cmovg rcx, rdx"
+  "push rcx")
+
 (defun gen-code (op str)
   (let ((op-fn (gethash (car op) *operations*)))
     (if (null op-fn)