diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/cljcc/compiler.clj | 115 | ||||
| -rw-r--r-- | src/cljcc/driver.clj | 15 | ||||
| -rw-r--r-- | src/cljcc/emit.clj | 30 |
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 |