Add code emission for chapter 3

Fix small bug in driver, it emitted the file in assembly step

Add new instructions for code emission

3 files changed, 130 insertions, 30 deletions

diff --git a/src/cljcc/compiler.clj b/src/cljcc/compiler.clj
index 028cfbe..5d21d64 100644
--- a/src/cljcc/compiler.clj
+++ b/src/cljcc/compiler.clj
@@ -4,6 +4,10 @@
             [clojure.pprint :as pp]
             [cljcc.tacky :as t]))
 
+(def registers #{:ax :dx :r10 :r11})
+
+;;;; Instructions
+
 (defn- mov-instruction [src dst]
   {:op  :mov
    :src src
@@ -21,6 +25,21 @@
    :unary-operator unary-operator
    :operand operand})
 
+(defn- binary-instruction [binop src dst]
+  {:op :binary
+   :binary-operator binop
+   :src src
+   :dst dst})
+
+(defn- cdq-instruction []
+  {:op :cdq})
+
+(defn- idiv-instruction [operand]
+  {:op :idiv
+   :operand operand})
+
+;;;; Operands
+
 (defn- imm-operand [v]
   {:operand :imm
    :value v})
@@ -37,6 +56,8 @@
   {:operand :pseudo
    :identifier identifier})
 
+;;;; Tacky -> Instructions
+
 (defn- tacky-val->assembly-operand [val]
   (let [type (:type val)
         v (:value val)]
@@ -56,9 +77,28 @@
         unop (:unary-operator instruction)]
     [(mov-instruction src dst) (unary-instruction unop dst)]))
 
+(defn- tacky-binary->assembly [instruction]
+  (let [binop (:binary-operator instruction)
+        src1 (tacky-val->assembly-operand (:src1 instruction))
+        src2 (tacky-val->assembly-operand (:src2 instruction))
+        dst (tacky-val->assembly-operand (:dst instruction))
+        div? (= binop :div)
+        mod? (= binop :mod)]
+    (cond
+      div? [(mov-instruction src1 (reg-operand :ax))
+            (cdq-instruction)
+            (idiv-instruction src2)
+            (mov-instruction (reg-operand :ax) dst)]
+      mod? [(mov-instruction src1 (reg-operand :ax))
+            (cdq-instruction)
+            (idiv-instruction src2)
+            (mov-instruction (reg-operand :dx) dst)]
+      :else [(mov-instruction src1 dst) (binary-instruction binop src2 dst)])))
+
 (def tacky->assembly-transformers
   {:unary #'tacky-unary->assembly
-   :return #'tacky-return->assembly})
+   :return #'tacky-return->assembly
+   :binary #'tacky-binary->assembly})
 
 (defn- tacky-inst->assembly-inst [inst]
   (let [transformer-fn ((:type inst) tacky->assembly-transformers)]
@@ -112,30 +152,61 @@
     {:max-stack-val  (get pseudo-value-map "current")
      :instructions (map #(pseudo->stack-operand-instruction pseudo-value-map %) instructions)}))
 
-(defn- allocate-scratch-register [instruction]
-  (let [mov-both-stack? (fn [i]
-                          (and
-                           (= (:op i) :mov)
-                           (= (get-in i [:src :operand]) :stack)
-                           (= (get-in i [:dst :operand]) :stack)))
-        allocate-register-fn (fn [i]
-                               (if (mov-both-stack? i)
-                                 [(mov-instruction (get i :src) (reg-operand :r10))
-                                  (mov-instruction (reg-operand :r10) (get i :dst))]
-                                 i))]
-    (allocate-register-fn instruction)))
-
-(defn- fix-stack-instructions [{instructions :instructions max-stack-val :max-stack-val}]
-  (let [allocate-stack-inst (allocate-stack-instruction max-stack-val)
-        fixed-instructions (flatten (map allocate-scratch-register instructions))]
-    (cons allocate-stack-inst fixed-instructions)))
+(defn- fix-binary-instruction [instruction]
+  (let [binop (:binary-operator instruction)
+        src (:src instruction)
+        dst (:dst instruction)
+        mul? (= binop :mul)]
+    (if mul?
+      (let [dst-memory-address? (= :stack (:operand dst))]
+        (if dst-memory-address?
+          [(mov-instruction dst (reg-operand :r11))
+           (binary-instruction binop src (reg-operand :r11))
+           (mov-instruction (reg-operand :r11) dst)]
+          instruction))
+      (let [both-memory-address? (and
+                                  (= :stack (:operand src))
+                                  (= :stack (:operand dst)))]
+        (if both-memory-address?
+          [(mov-instruction src (reg-operand :r10))
+           (binary-instruction binop (reg-operand :r10) dst)]
+          instruction)))))
+
+(defn- fix-mov-instruction [instruction]
+  (let [both-memory-address? (and
+                              (= :stack (get-in instruction [:src :operand]))
+                              (= :stack (get-in instruction [:dst :operand])))]
+    (if both-memory-address?
+      [(mov-instruction (get instruction :src) (reg-operand :r10))
+       (mov-instruction (reg-operand :r10) (get instruction :dst))]
+      instruction)))
+
+(defn- fix-idiv-instruction [instruction]
+  (if (= :imm (get-in instruction [:operand :operand]))
+    [(mov-instruction (:operand instruction) (reg-operand :r10))
+     (idiv-instruction (reg-operand :r10))]
+    instruction))
+
+(def fix-instruction-map
+  {:idiv #'fix-idiv-instruction
+   :mov #'fix-mov-instruction
+   :binary #'fix-binary-instruction})
+
+(defn- fix-instruction [instruction]
+  (let [f (or ((:op instruction) fix-instruction-map) #'identity)]
+    (f instruction)))
+
+(defn- add-allocate-stack-instruction [{instructions :instructions max-stack-val :max-stack-val}]
+  (cons (allocate-stack-instruction max-stack-val) instructions))
 
 (defn- assembly-generate-instructions [tacky-instructions]
   (->> tacky-instructions
        (map tacky-inst->assembly-inst)
-       (flatten)
-       (replace-pseudoregisters)
-       (fix-stack-instructions)))
+       flatten
+       replace-pseudoregisters
+       add-allocate-stack-instruction
+       (map fix-instruction)
+       flatten))
 
 (defn- transform-function [_return-type identifier args body]
   {:op :function
@@ -165,7 +236,7 @@
   (pp/pprint
    (generate-assembly
     "int main(void) {
-return ~(-(~(-1)));
+return 1 + 2;
 }"))
 
   ())
diff --git a/src/cljcc/driver.clj b/src/cljcc/driver.clj
index b039ba4..2869561 100644
--- a/src/cljcc/driver.clj
+++ b/src/cljcc/driver.clj
@@ -34,6 +34,13 @@
 (defn assemble-step [directory filename]
   (let [file-without-ext (remove-extension filename)
         assembly-file (make-file-name directory file-without-ext "s")
+        preprocessed-file-path (make-file-name directory (remove-extension filename) "i")
+        file (io/file preprocessed-file-path)
+        source (slurp file)
+        assembly-ast (c/generate-assembly source)
+        assembly-output (e/emit assembly-ast)
+        assembly-out-file-path (make-file-name directory (remove-extension filename) "s")
+        _ (spit assembly-out-file-path assembly-output)
         output-file (str directory "/" file-without-ext)
         output (handle-sh "gcc" assembly-file "-o" output-file)]
     (if (= 1 (:exit output))
@@ -61,12 +68,8 @@
   (let [preprocessed-file-path (make-file-name directory (remove-extension filename) "i")
         file (io/file preprocessed-file-path)
         source (slurp file)
-        assembly-ast (c/generate-assembly source)
-        assembly-output (e/emit assembly-ast)
-        out-file-path (make-file-name directory (remove-extension filename) "s")]
-    (spit out-file-path assembly-output)
-    (log/info (str "Succesfully generated assembly ast.\n" assembly-ast))
-    (log/info (str "Succesfully generated assembly file.\n" assembly-output))))
+        assembly-ast (c/generate-assembly source)]
+    (log/info (str "Succesfully generated assembly ast.\n" assembly-ast))))
 
 (defn cleanup-step [directory filename]
   (let [file-without-ext (remove-extension filename)]
diff --git a/src/cljcc/emit.clj b/src/cljcc/emit.clj
index f405119..080886e 100644
--- a/src/cljcc/emit.clj
+++ b/src/cljcc/emit.clj
@@ -5,6 +5,8 @@
             [clojure.string :as str]
             [clojure.pprint :as pp]))
 
+;;;; Operand Emit
+
 (defn- imm-opernad-emit [operand]
   (format "$%d" (:value operand)))
 
@@ -14,7 +16,9 @@
 (defn- register-operand [operand]
   (condp = (:register operand)
     :ax "%eax"
+    :dx "%edx"
     :r10 "%r10d"
+    :r11 "%r11d"
     (throw (AssertionError. (str "Invalid register operand: " operand)))))
 
 (def operand-emitters
@@ -28,6 +32,8 @@
     (operand-emit-fn operand)
     (throw (AssertionError. (str "Invalid operand: " operand)))))
 
+;;;; Instruction Emit
+
 (defn- mov-instruction-emit [instruction]
   (let [src (operand-emit (:src instruction))
         dst (operand-emit (:dst instruction))]
@@ -43,9 +49,26 @@
         assembly-operator (condp = (:unary-operator instruction)
                             :complement "notl"
                             :negate "negl"
-                            (throw (AssertionError. (str "Invalid unary operator." instruction))))]
+                            (throw (AssertionError. (str "Invalid unary operator: " instruction))))]
     [(format "    %s        %s" assembly-operator operand)]))
 
+(defn- binary-instruction-emit [instruction]
+  (let [src (operand-emit (:src instruction))
+        dst (operand-emit (:dst instruction))
+        binop (:binary-operator instruction)
+        binop-operator (condp = binop
+                         :add "addl"
+                         :sub "subl"
+                         :mul "imull"
+                         (throw (AssertionError. (str "Invalid binary operator: " instruction))))]
+    [(format "    %s        %s, %s" binop-operator src dst)]))
+
+(defn- cdq-instruction-emit [_instruction]
+  ["    cdq"])
+
+(defn- idiv-instruction-emit [instruction]
+  [(format "    idivl       %s" (operand-emit (:operand instruction)))])
+
 (defn- allocate-stack-instruction-emit [instruction]
   [(format "    subq        $%d, %%rsp" (:value instruction))])
 
@@ -53,6 +76,9 @@
   "Map of assembly instructions to function emitters."
   {:mov #'mov-instruction-emit
    :ret #'ret-instruction-emit
+   :binary #'binary-instruction-emit
+   :cdq #'cdq-instruction-emit
+   :idiv #'idiv-instruction-emit
    :unary #'unary-instruction-emit
    :allocate-stack #'allocate-stack-instruction-emit})
 
@@ -124,7 +150,7 @@
    (emit
     (c/generate-assembly
      "int main(void) {
-       return -(((((10)))));
+       return 6 / 3 / 2;
     }")))
 
   (-> ex