Add assembly emission for storage specifiers

Pass chapter 10, finish book part 1

Fixed bug by threading symbol map through all statements

Fixed emitting tacky instructions for variables which are supposed to be
initialized in static section

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);}"))))
+")
 
   ())