Add relational and logical operators assembly and emission

Finish chapter 4 and extra bitwise tests

2 files changed, 158 insertions, 28 deletions

diff --git a/src/cljcc/compiler.clj b/src/cljcc/compiler.clj
index 4862d95..a7ee8c9 100644
--- a/src/cljcc/compiler.clj
+++ b/src/cljcc/compiler.clj
@@ -4,7 +4,9 @@
             [cljcc.tacky :as t]
             [cljcc.lexer :as l]))
 
-(def registers #{:ax :dx :r10 :r11})
+(def registers #{:ax :dx :r10 :r11 :cx :cl})
+
+(def cond-codes #{:e :ne :g :ge :l :le})
 
 ;;;; Instructions
 
@@ -13,13 +15,6 @@
    :src src
    :dst dst})
 
-(defn- ret-instruction []
-  {:op :ret})
-
-(defn- allocate-stack-instruction [v]
-  {:op :allocate-stack
-   :value v})
-
 (defn- unary-instruction [unary-operator operand]
   {:op :unary
    :unary-operator unary-operator
@@ -31,6 +26,11 @@
    :src src
    :dst dst})
 
+(defn- cmp-instruction [src dst]
+  {:op :cmp
+   :src src
+   :dst dst})
+
 (defn- cdq-instruction []
   {:op :cdq})
 
@@ -38,6 +38,33 @@
   {:op :idiv
    :operand operand})
 
+(defn- jmp-instruction [identifier]
+  {:op :jmp
+   :identifier identifier})
+
+(defn- jmpcc-instruction [cond-code identifier]
+  {:pre [(contains? cond-codes cond-code)]}
+  {:op :jmpcc
+   :identifier identifier
+   :cond-code cond-code})
+
+(defn- setcc-instruction [cond-code operand]
+  {:pre [(contains? cond-codes cond-code)]}
+  {:op :setcc
+   :operand operand
+   :cond-code cond-code})
+
+(defn- label-instruction [identifier]
+  {:op :label
+   :identifier identifier})
+
+(defn- allocate-stack-instruction [v]
+  {:op :allocate-stack
+   :value v})
+
+(defn- ret-instruction []
+  {:op :ret})
+
 ;;;; Operands
 
 (defn- imm-operand [v]
@@ -45,6 +72,7 @@
    :value v})
 
 (defn- reg-operand [reg]
+  {:pre [(contains? registers reg)]}
   {:operand :reg
    :register reg})
 
@@ -74,8 +102,21 @@
 (defn- tacky-unary->assembly [instruction]
   (let [src (tacky-val->assembly-operand (:src instruction))
         dst (tacky-val->assembly-operand (:dst instruction))
-        unop (:unary-operator instruction)]
-    [(mov-instruction src dst) (unary-instruction unop dst)]))
+        unop (:unary-operator instruction)
+        logical-not? (= :logical-not unop)]
+    (cond
+      logical-not? [(cmp-instruction (imm-operand 0) src)
+                    (mov-instruction (imm-operand 0) dst)
+                    (setcc-instruction :e dst)]
+      :else [(mov-instruction src dst) (unary-instruction unop dst)])))
+
+(def relational-ops
+  {:greater-than :g
+   :less-than :l
+   :equal :e
+   :not-equal :ne
+   :less-or-equal :le
+   :greater-or-equal :ge})
 
 (defn- tacky-binary->assembly [instruction]
   (let [binop (:binary-operator instruction)
@@ -84,6 +125,7 @@
         dst (tacky-val->assembly-operand (:dst instruction))
         div? (= binop :div)
         mod? (= binop :mod)
+        relational? (contains? relational-ops binop)
         bit-shift? (contains? #{:bit-right-shift :bit-left-shift} binop)]
     (cond
       div? [(mov-instruction src1 (reg-operand :ax))
@@ -94,15 +136,46 @@
             (cdq-instruction)
             (idiv-instruction src2)
             (mov-instruction (reg-operand :dx) dst)]
+      relational? [(cmp-instruction src2 src1)
+                   (mov-instruction (imm-operand 0) dst)
+                   (setcc-instruction (binop relational-ops) dst)]
       bit-shift? [(mov-instruction src1 dst)
                   (mov-instruction src2 (reg-operand :cx))
                   (binary-instruction binop (reg-operand :cl) dst)]
       :else [(mov-instruction src1 dst) (binary-instruction binop src2 dst)])))
 
+(defn- tacky-jump-if-zero->assembly [instruction]
+  (let [val (tacky-val->assembly-operand (:val instruction))
+        target (:identifier instruction)]
+    [(cmp-instruction (imm-operand 0) val)
+     (jmpcc-instruction :e target)]))
+
+(defn- tacky-jump-if-not-zero->assembly [instruction]
+  (let [val (tacky-val->assembly-operand (:val instruction))
+        target (:identifier instruction)]
+    [(cmp-instruction (imm-operand 0) val)
+     (jmpcc-instruction :ne target)]))
+
+(defn- tacky-jump->assembly [instruction]
+  [(jmp-instruction (:identifier instruction))])
+
+(defn- tacky-copy->assembly [instruction]
+  (let [src (tacky-val->assembly-operand (:src instruction))
+        dst (tacky-val->assembly-operand (:dst instruction))]
+    [(mov-instruction src dst)]))
+
+(defn- tacky-label->assembly [instruction]
+  [(label-instruction (:identifier instruction))])
+
 (def tacky->assembly-transformers
   {:unary #'tacky-unary->assembly
    :return #'tacky-return->assembly
-   :binary #'tacky-binary->assembly})
+   :binary #'tacky-binary->assembly
+   :copy #'tacky-copy->assembly
+   :jump #'tacky-jump->assembly
+   :label #'tacky-label->assembly
+   :jump-if-zero #'tacky-jump-if-zero->assembly
+   :jump-if-not-zero #'tacky-jump-if-not-zero->assembly})
 
 (defn- tacky-inst->assembly-inst [inst]
   (let [transformer-fn ((:type inst) tacky->assembly-transformers)]
@@ -189,9 +262,22 @@
      (idiv-instruction (reg-operand :r10))]
     instruction))
 
+(defn- fix-cmp-instruction [instruction]
+  (let [both-memory-address? (and
+                              (= :stack (get-in instruction [:src :operand]))
+                              (= :stack (get-in instruction [:dst :operand])))
+        dst-constant? (= :imm (get-in instruction [:dst :operand]))]
+    (cond
+      both-memory-address? [(mov-instruction (get instruction :src) (reg-operand :r10))
+                            (cmp-instruction (reg-operand :r10) (get instruction :dst))]
+      dst-constant? [(mov-instruction (get instruction :dst) (reg-operand :r11))
+                     (cmp-instruction (get instruction :src) (reg-operand :r11))]
+      :else instruction)))
+
 (def fix-instruction-map
   {:idiv #'fix-idiv-instruction
    :mov #'fix-mov-instruction
+   :cmp #'fix-cmp-instruction
    :binary #'fix-binary-instruction})
 
 (defn- fix-instruction [instruction]
@@ -236,7 +322,7 @@
   (pp/pprint
    (generate-assembly
     "int main(void) {
-return 1 + 2;
+return 1 >= 2;
 }"))
 
   ())
diff --git a/src/cljcc/emit.clj b/src/cljcc/emit.clj
index e69f07a..8a12d76 100644
--- a/src/cljcc/emit.clj
+++ b/src/cljcc/emit.clj
@@ -5,23 +5,38 @@
             [clojure.string :as str]
             [clojure.pprint :as pp]))
 
+(defn- handle-label [identifier]
+  (condp = (get-os)
+    :mac (str "L" identifier)
+    :linux (str ".L" identifier)
+    (throw (ex-info "Error in generating label." {}))))
+
 ;;;; Operand Emit
 
-(defn- imm-opernad-emit [operand]
+(defn- imm-opernad-emit [operand _opts]
   (format "$%d" (:value operand)))
 
-(defn- stack-operand-emit [operand]
+(defn- stack-operand-emit [operand _opts]
   (format "%d(%%rbp)" (:value operand)))
 
-(defn- register-operand [operand]
-  (condp = (:register operand)
-    :ax "%eax"
-    :dx "%edx"
-    :r10 "%r10d"
-    :r11 "%r11d"
-    :cx "%ecx"
-    :cl "%cl"
-    (throw (AssertionError. (str "Invalid register operand: " operand)))))
+(defn- register-operand [operand opts]
+  (if (contains? opts :byte-1)
+    (condp = (:register operand)
+      :ax "%al"
+      :dx "%dl"
+      :r10 "%r10b"
+      :r11 "%r11b"
+      :cx "%cl"
+      :cl "%cl"
+      (throw (AssertionError. (str "Invalid register operand: " operand))))
+    (condp = (:register operand)
+      :ax "%eax"
+      :dx "%edx"
+      :r10 "%r10d"
+      :r11 "%r11d"
+      :cx "%ecx"
+      :cl "%cl"
+      (throw (AssertionError. (str "Invalid register operand: " operand))))))
 
 (def operand-emitters
   "Map of assembly operands to operand emitters."
@@ -29,10 +44,13 @@
    :reg #'register-operand
    :stack #'stack-operand-emit})
 
-(defn- operand-emit [operand]
-  (if-let [[_ operand-emit-fn] (find operand-emitters (:operand operand))]
-    (operand-emit-fn operand)
-    (throw (AssertionError. (str "Invalid operand: " operand)))))
+(defn- operand-emit
+  ([operand]
+   (operand-emit operand {}))
+  ([operand opts]
+   (if-let [[_ operand-emit-fn] (find operand-emitters (:operand operand))]
+     (operand-emit-fn operand opts)
+     (throw (AssertionError. (str "Invalid operand: " operand))))))
 
 ;;;; Instruction Emit
 
@@ -41,6 +59,27 @@
         dst (operand-emit (:dst instruction))]
     [(format "    %s        %s, %s" "movl" src dst)]))
 
+(defn- cmp-instruction-emit [instruction]
+  (let [src (operand-emit (:src instruction))
+        dst (operand-emit (:dst instruction))]
+    [(format "    %s       %s, %s" "cmpl" src dst)]))
+
+(defn- jmp-instruction-emit [instruction]
+  [(format "    jmp        %s" (handle-label (:identifier instruction)))])
+
+(defn- jmpcc-instruction-emit [instruction]
+  (let [cc (name (:cond-code instruction))
+        label (handle-label (:identifier instruction))]
+    [(format "    j%s        %s" cc label)]))
+
+(defn- setcc-instruction-emit [instruction]
+  (let [cc (name (:cond-code instruction))
+        operand (operand-emit (:operand instruction) {:byte-1 true})]
+    [(format "    set%s        %s" cc operand)]))
+
+(defn- label-instruction-emit [instruction]
+  [(format "    %s:" (handle-label (:identifier instruction)))])
+
 (defn- ret-instruction-emit [_instruction]
   ["    movq        %rbp, %rsp"
    "    popq        %rbp"
@@ -87,6 +126,11 @@
    :cdq #'cdq-instruction-emit
    :idiv #'idiv-instruction-emit
    :unary #'unary-instruction-emit
+   :setcc #'setcc-instruction-emit
+   :jmp #'jmp-instruction-emit
+   :jmpcc #'jmpcc-instruction-emit
+   :label #'label-instruction-emit
+   :cmp #'cmp-instruction-emit
    :allocate-stack #'allocate-stack-instruction-emit})
 
 (defn instruction-emit [instruction]
@@ -157,7 +201,7 @@
    (emit
     (c/generate-assembly
      "int main(void) {
-       return 6 / 3 / 2;
+       return 1 + 2 == 4 + 5;
     }")))
 
   (println