Assembly generation for trivial programs

7 files changed, 156 insertions, 43 deletions

diff --git a/README.org b/README.org
index 246940b..650f6a4 100644
--- a/README.org
+++ b/README.org
@@ -1,12 +1,18 @@
-*** General
+* General
 
 This compiler was made following the general guidelines provided in /Writing a C Compiler/ by Nora Sandler.
 It is written solely using tools distributed with Guile.
 
-*** Features
+* Feature Agenda
 
-It features a large subset of the C language:
+** TODO Important
 
+- [ ] Reasonable parser error messages
+- [ ] More parenthesis
+
+** TODO Features [0/19]
+
+- [ ] Trivial Programs
 - [ ] Unary Operators
 - [ ] Binary Operators
 - [ ] Logical and Relational Operators
diff --git a/src/gscc b/src/gscc
index c5ddbd3..87449ee 100755
--- a/src/gscc
+++ b/src/gscc
@@ -4,8 +4,9 @@
 
 
 (use-modules (ice-9 getopt-long)
-	     (modules lexer lexer)
-	     (modules parser parser))
+             (modules lexer lexer)
+             (modules parser parser)
+             (modules generator generator))
 
 
 (define version "v0.1")
@@ -14,13 +15,13 @@
 (define (error message)
   (display (string-concatenate `(,message "
 Usage:
-	gscc [OPTIONS] file
+        gscc [OPTIONS] file
 Options:
-	--version, -v: print version information
-	--debug,   -d: turn on verbose output
-	--lex,     -l: run the lexer, but stop before assembly generation
-	--parse,   -p: run the lexer and parser, but stop before assembly generation
-	--codegen, -c: perform lexing, parsing, and assembly generation, but stop before code emission")))
+        --version, -v: print version information
+        --debug,   -d: turn on verbose output
+        --lex,     -l: run the lexer, but stop before assembly generation
+        --parse,   -p: run the lexer and parser, but stop before assembly generation
+        --codegen, -c: perform lexing, parsing, and assembly generation, but stop before code emission")))
   (exit #f))
 
 (define (preprocess file)
@@ -35,11 +36,13 @@ file on a success."
 (define (process file parse? assemble?)
   "Driver for lexing, parsing, and assembly generation."
   (let* ((port (open-input-file file))
-	 (tokens (begin (set-current-input-port port)
-			(read-tokens))))
+         (tokens (begin (set-current-input-port port)
+                        (read-tokens))))
+    (close-input-port port)
     (when parse?
-      (p-program tokens))
-    (close-input-port port)))
+      (let ((ast (p-program tokens)))
+        (when assemble?
+          (display (generate ast)))))))
 
 (define (postprocess file dest)
   "Assembles and links file, producing an executable.
@@ -48,28 +51,28 @@ Returns #f on a failure, #t on a success."
 
 (define (main args)
   (let* ((option-spec
-	  '((version (single-char #\v) (value #f))
-	    (debug   (single-char #\d) (value #f))
-	    (lex     (single-char #\l) (value #f))
-	    (parse   (single-char #\p) (value #f))
-	    (codegen (single-char #\c) (value #f))))
-	 (options (getopt-long args option-spec))
-	 (rest (option-ref options '() #f))
-	 (file (if (null? rest) #f (car rest))))
+          '((version (single-char #\v) (value #f))
+            (debug   (single-char #\d) (value #f))
+            (lex     (single-char #\l) (value #f))
+            (parse   (single-char #\p) (value #f))
+            (codegen (single-char #\c) (value #f))))
+         (options (getopt-long args option-spec))
+         (rest (option-ref options '() #f))
+         (file (if (null? rest) #f (car rest))))
     (cond
      ((option-ref options 'version #f)
       (display (string-concatenate `("gscc (the 'Guile Scheme C Compiler', " ,version ")\n"))))
      ((not (equal? 1 (length rest))) (error "Wrong number of arguments."))
      ((or (not file)
-	  (not (access? file R_OK))
-	  (not (equal? 'regular (stat:type (stat file))))) (error "The file could not be read."))
+          (not (access? file R_OK))
+          (not (equal? 'regular (stat:type (stat file))))) (error "The file could not be read."))
      (#t
       (let ((source (preprocess file)))
-	(when source
-	  (display (string-concatenate `("Preprocess reported success (wrote " ,source ").\n")))
-	  (process source
-		   (not (option-ref options 'lex #f))
-		   (not (option-ref options 'parse #f)))))))))
+        (when source
+          (display (string-concatenate `("Preprocess reported success (wrote " ,source ").\n")))
+          (process source
+                   (not (option-ref options 'lex #f))
+                   (not (option-ref options 'parse #f)))))))))
 
 
 ;; Local Variables:
diff --git a/src/modules/ast/assembly-tree.scm b/src/modules/ast/assembly-tree.scm
new file mode 100644
index 0000000..ee3e116
--- /dev/null
+++ b/src/modules/ast/assembly-tree.scm
@@ -0,0 +1,25 @@
+(define-module (modules ast assembly-tree)
+  #:use-module (srfi srfi-9)
+  #:export (make-subroutine
+            subroutine?
+            subroutine-label
+            subroutine-instructions
+
+            make-instruction
+            instruction?
+            instruction-operator
+            instruction-operand-1
+            instruction-operand-2))
+
+(define-record-type <subroutine>
+  (make-subroutine label instrs)
+  subroutine?
+  (label subroutine-label)
+  (instrs subroutine-instructions))
+
+(define-record-type <instruction>
+  (make-instruction op oper1 oper2)
+  instruction?
+  (op instruction-operator)
+  (oper1 instruction-operand-1)
+  (oper2 instruction-operand-2))
diff --git a/src/modules/ast/syntax-tree.scm b/src/modules/ast/syntax-tree.scm
new file mode 100644
index 0000000..738b115
--- /dev/null
+++ b/src/modules/ast/syntax-tree.scm
@@ -0,0 +1,48 @@
+(define-module (modules ast syntax-tree)
+  #:use-module (srfi srfi-9)
+  #:export (make-program
+            program?
+            program-function
+
+            make-function
+            function?
+            function-id
+            function-stmt
+
+            make-stmt
+            stmt?
+            stmt-expr
+
+            make-expr
+            expr?
+            expr-int
+
+            make-id
+            id?
+            id-symbol))
+
+(define-record-type <program>
+  (make-program func)
+  program?
+  (func program-function))
+
+(define-record-type <function>
+  (make-function id stmt)
+  function?
+  (id function-id)
+  (stmt function-stmt))
+
+(define-record-type <stmt>
+  (make-stmt expr)
+  stmt?
+  (expr stmt-expr))
+
+(define-record-type <expr>
+  (make-expr int)
+  expr?
+  (int expr-int))
+
+(define-record-type <id>
+  (make-id symbol)
+  id?
+  (symbol id-symbol))
diff --git a/src/modules/generator/generator.scm b/src/modules/generator/generator.scm
new file mode 100644
index 0000000..4c08e32
--- /dev/null
+++ b/src/modules/generator/generator.scm
@@ -0,0 +1,31 @@
+(define-module (modules generator generator)
+  #:use-module (modules ast syntax-tree)
+  #:use-module (modules ast assembly-tree)
+  #:export (generate))
+
+(define (generate node)
+  (cond
+   ((program? node) (g-program node))
+   ((function? node) (g-function node))
+   ((stmt? node) (g-stmt node))
+   ((expr? node) (g-expr node))
+   ((id? node) (g-id node))
+   (else (error "Unknown AST element"))))
+
+(define (g-program p)
+  (make-program (generate (program-function p))))
+
+(define (g-function f)
+  (make-subroutine (generate (function-id f))
+                   (generate (function-stmt f))))
+
+(define (g-stmt s)
+  (generate (stmt-expr s)))
+
+(define (g-expr e)
+  ;; for now, we assume only 'return'!
+  (list (make-instruction "mov1" "%eax" "$2")
+        (make-instruction "ret" #f #f)))
+
+(define (g-id i)
+  (id-symbol i))
diff --git a/src/modules/parser/parser.scm b/src/modules/parser/parser.scm
index e70a825..ceac389 100644
--- a/src/modules/parser/parser.scm
+++ b/src/modules/parser/parser.scm
@@ -1,34 +1,32 @@
 (define-module (modules parser parser)
   #:use-module (ice-9 match)
+  #:use-module (modules ast syntax-tree)
   #:export (p-program))
 
 
 (define (die)
   (error "syntax error"))
 
-
 (define (p-program tokens)
   (match tokens
     ((func ...)
-     `(program ,(p-function func)))
+     (make-program (p-function func)))
     (_ (die))))
 
 (define (p-function tokens)
   (match tokens
     (('int (? string? id) 'left-paren 'void 'right-paren 'open-brace stmt ... 'close-brace)
-     `(function (identifier ,id) ,(p-statement stmt)))
+     (make-function (make-id id) (p-stmt stmt)))
     (_ (die))))
 
-(define (p-statement tokens)
+(define (p-stmt tokens)
   (match tokens
     (`(return ,expr semi-colon)
-     `(return ,(p-exp (list expr))))
+     (make-stmt (p-expr (list expr))))
     (_ (die))))
 
-(define (p-exp tokens)
-  "Matches any list containing a single number,
-"
+(define (p-expr tokens)
   (match tokens
-    (((? number? const))
-     `(constant ,const))
+    (((? number? int))
+     (make-expr int))
     (_ (die))))
diff --git a/src/unit-tests/parser/parser-test.scm b/src/unit-tests/parser/parser-test.scm
index 8baedda..61f9e03 100644
--- a/src/unit-tests/parser/parser-test.scm
+++ b/src/unit-tests/parser/parser-test.scm
@@ -6,7 +6,6 @@
 (test-begin "parser-harness")
 
 
-
 (test-equal "trivial function main 2"
   '(program (function (identifier "main") (return (constant 2))))
   (p-program '(int "main" left-paren void right-paren open-brace return 2 semi-colon close-brace)))
@@ -19,10 +18,13 @@
 	    (p-program '(int "foo" left-paren void right-paren open-brace return return 4 semi-colon close-brace)))
 
 (test-error "trivial function bad parens"
-	    (p-program '(int "foo" right-paren void left-paren open-brace return return 4 semi-colon close-brace)))
+	    (p-program '(int "foo" right-paren void left-paren open-brace return 4 semi-colon close-brace)))
 
 (test-error "trivial function bad int parameter"
-	    (p-program '(int "foo" right-paren int left-paren open-brace return return 4 semi-colon close-brace)))
+	    (p-program '(int "foo" left-paren int right-paren open-brace return 4 semi-colon close-brace)))
+
+(test-error "trivial function incomplete function"
+	    (p-program '(int "foo" left-paren void right-paren open-brace return)))
 
 
 (test-end "parser-harness")