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