diff options
| -rw-r--r-- | src/cljcc/analyzer.clj | 41 | ||||
| -rw-r--r-- | src/cljcc/compiler.clj | 1 | ||||
| -rw-r--r-- | src/cljcc/emit.clj | 78 | ||||
| -rw-r--r-- | src/cljcc/tacky.clj | 42 |
4 files changed, 88 insertions, 74 deletions
diff --git a/src/cljcc/analyzer.clj b/src/cljcc/analyzer.clj index 31039db..0d8a763 100644 --- a/src/cljcc/analyzer.clj +++ b/src/cljcc/analyzer.clj @@ -525,7 +525,6 @@ (typecheck-declaration for-init ident->symbol) (typecheck-optional-expression for-init ident->symbol))) -;; TODO: typechecking must thread through all recursive typecheck statement (defn- typecheck-statement [{:keys [statement-type] :as s} ident->symbol] (condp = statement-type :return (do @@ -537,41 +536,40 @@ {:statement s :ident->symbol ident->symbol}) :if (if (:else-statement s) - (do - (typecheck-exp (:condition s) ident->symbol) - (typecheck-statement (:then-statement s) ident->symbol) - (typecheck-statement (:else-statement s) ident->symbol) + (let + [_ (typecheck-exp (:condition s) ident->symbol) + {i->s :ident->symbol} (typecheck-statement (:then-statement s) ident->symbol) + {i->s :ident->symbol} (typecheck-statement (:else-statement s) i->s)] {:statement s - :ident->symbol ident->symbol}) - (do - (typecheck-exp (:condition s) ident->symbol) - (typecheck-statement (:then-statement s) ident->symbol) + :ident->symbol i->s}) + (let + [_ (typecheck-exp (:condition s) ident->symbol) + {i->s :ident->symbol} (typecheck-statement (:then-statement s) ident->symbol)] {:statement s - :ident->symbol ident->symbol})) + :ident->symbol i->s})) :break {:statement s :ident->symbol ident->symbol} :continue {:statement s :ident->symbol ident->symbol} - :while (do - (typecheck-exp (:condition s) ident->symbol) - (typecheck-statement (:body s) ident->symbol) + :while (let + [_ (typecheck-exp (:condition s) ident->symbol) + {i->s :ident->symbol} (typecheck-statement (:body s) ident->symbol)] {:statement s - :ident->symbol ident->symbol}) - :do-while (do - (typecheck-exp (:condition s) ident->symbol) - (typecheck-statement (:body s) ident->symbol) + :ident->symbol i->s}) + :do-while (let + [_ (typecheck-exp (:condition s) ident->symbol) + {i->s :ident->symbol} (typecheck-statement (:body s) ident->symbol)] {:statement s - :ident->symbol ident->symbol}) + :ident->symbol i->s}) :for (let [f-init (typecheck-for-init (:init s) ident->symbol) updated-symbols (if (:declaration f-init) (:ident->symbol f-init) ident->symbol) _ (typecheck-optional-expression (:condition s) updated-symbols) _ (typecheck-optional-expression (:post s) updated-symbols) - _ (typecheck-statement (:body s) updated-symbols)] + {i->s :ident->symbol} (typecheck-statement (:body s) updated-symbols)] {:statement s - :ident->symbol ident->symbol}) - ;; TODO: Standardize returning map from statements + :ident->symbol i->s}) :compound (let [v (typecheck-block (:block s) ident->symbol)] {:statement s :ident->symbol (:ident->symbol v)}) @@ -637,6 +635,7 @@ int static y = 10; extern int x = 0; int main(void) { +int z = 100; return 2; } ") diff --git a/src/cljcc/compiler.clj b/src/cljcc/compiler.clj index d40bc4b..5f77dc4 100644 --- a/src/cljcc/compiler.clj +++ b/src/cljcc/compiler.clj @@ -1,6 +1,5 @@ (ns cljcc.compiler (:require [cljcc.parser :as p] - [clojure.pprint :as pp] [cljcc.tacky :as t] [cljcc.lexer :as l] [cljcc.analyzer :as a] diff --git a/src/cljcc/emit.clj b/src/cljcc/emit.clj index 866fe91..d753473 100644 --- a/src/cljcc/emit.clj +++ b/src/cljcc/emit.clj @@ -1,10 +1,9 @@ (ns cljcc.emit - (:require [cljcc.parser :as p] - [cljcc.util :refer [get-os]] - [cljcc.compiler :as c] - [clojure.string :as str] - [clojure.pprint :as pp] - [cljcc.symbols :as symbols])) + (:require + [cljcc.util :refer [get-os]] + [cljcc.compiler :as c] + [clojure.string :as str] + [cljcc.symbols :as symbols])) (defn- handle-label [identifier] (condp = (get-os) @@ -12,15 +11,14 @@ :linux (str ".L" identifier) (throw (ex-info "Error in generating label." {})))) - -(defn- handle-function-name [name] +(defn- handle-symbol-name [name] (if (= :mac (get-os)) (str "_" name) name)) (defn- handle-current-translation-unit [name] (if (= :mac (get-os)) - (handle-function-name name) + (handle-symbol-name name) (if (contains? @symbols/symbols name) name (str name "@PLT")))) @@ -33,6 +31,9 @@ (defn- stack-operand-emit [operand _opts] (format "%d(%%rbp)" (:value operand))) +(defn- data-operand-emit [operand _opts] + (format "%s(%%rip)" (handle-symbol-name (:identifier operand)))) + (defn- register-operand [{:keys [register] :as operand} {register-width :register-width :or {register-width :4-byte}}] (let [register->width->output {:ax {:8-byte "%rax" :4-byte "%eax" @@ -80,6 +81,7 @@ "Map of assembly operands to operand emitters." {:imm #'imm-opernad-emit :reg #'register-operand + :data #'data-operand-emit :stack #'stack-operand-emit}) (defn- operand-emit @@ -188,18 +190,40 @@ (instruction-emit-fn instruction) (throw (AssertionError. (str "Invalid instruction: " instruction))))) -(defn function-definition-emit [f] - (let [name (handle-function-name (:identifier f)) - globl (format " .globl %s", name) +(defn function-definition-emit [{:keys [identifier instructions global?]}] + (let [name (handle-symbol-name identifier) + globl (if global? + (format " .globl %s", name) + "") name-line (format "%s:" name) - instructions (map instruction-emit (:instructions f))] - (flatten [globl - name-line - " pushq %rbp" - " movq %rsp, %rbp" - instructions]))) - -(defn- static-variable-definition-emit [{:keys [identifier global? initial-value]}]) + instructions (mapv instruction-emit instructions)] + (->> [globl + " .text" + name-line + " pushq %rbp" + " movq %rsp, %rbp" + instructions + "\n"] + flatten + (filterv not-empty)))) + +(defn- static-variable-definition-emit [{:keys [identifier global? initial-value]}] + (let [name (handle-symbol-name identifier) + globl (if global? + (format " .globl %s" name) + "") + data-or-bss (if (zero? initial-value) + " .bss" + " .data") + size-val (if (zero? initial-value) + " .zero 4" + (format " .long %d" initial-value))] + (filterv not-empty [globl + data-or-bss + " .balign 4" + (format "%s:" name) + size-val + "\n"]))) (def emitters-top-level "Map of assembly top level constructs to their emitters." @@ -216,20 +240,20 @@ (defn emit [top-levels] (let [handle-os (fn [ast] (if (= :linux (get-os)) - (conj (conj (vec ast) linux-assembly-end) "\n") - (conj ast "\n")))] + (conj (conj (vec ast) linux-assembly-end)) + ast))] (->> top-levels - (map emit-top-level) + (mapv emit-top-level) concat flatten handle-os - (str/join "\n\n")))) + (str/join "\n")))) (comment - (emit - (c/generate-assembly - "int main(void) { + (emit + (c/generate-assembly + "int main(void) { return ~(-(~(-1))); }")) diff --git a/src/cljcc/tacky.clj b/src/cljcc/tacky.clj index d864f69..b25039b 100644 --- a/src/cljcc/tacky.clj +++ b/src/cljcc/tacky.clj @@ -1,11 +1,10 @@ (ns cljcc.tacky (:require - [clojure.pprint :as pp] [cljcc.lexer :as l] [cljcc.util :as u] [cljcc.parser :as p] - [cljcc.analyzer :as a] - [cljcc.symbols :as symbols])) + [cljcc.analyzer :as a])) + (defn- variable ([] @@ -357,9 +356,12 @@ (defn- declaration->tacky-instruction [d] (when (:initial d) - (let [var (parsed-var->tacky-var d) ; only needs :identifier key in declaration + (let [local? (nil? (:storage-class d)) + var (parsed-var->tacky-var d) ; only needs :identifier key in declaration rhs (exp-instructions (:initial d))] - (flatten [(:instructions rhs) (copy-instruction (:val rhs) var)])))) + (if local? + (flatten [(:instructions rhs) (copy-instruction (:val rhs) var)]) + [])))) ; ignoring initializers for non local variable declarations (defn- block-item->tacky-instruction [item] (condp = (:type item) @@ -430,30 +432,20 @@ (tacky-from-src " -static int x; +extern int foo; -extern int y = 100; +int foo; -int foo(int a) { -int b = a; -int z = 78 - 1; -return z; -} - -") +int foo; - (pp/pprint - (tacky-generate - (p/parse (l/lex "int main(void) { -int a = 1; -return 1;}")))) +int main(void) { + for (int i = 0; i < 5; i = i + 1) + foo = foo + 1; + return foo; +} - (pp/pprint - (tacky-generate - (p/parse (l/lex "int main(void) {return 1 * -2 / ~3 * (4 - 5);}")))) +int foo; - (pp/pprint - (tacky-generate - (p/parse (l/lex "int main(void) {return (1 + 2) || (3 + 4);}")))) +") ()) |