Implement assembly emission, allowing execution of trivial programs

Rewrite preprocess to return an input port rather than a temporary file.

3 files changed, 87 insertions, 41 deletions

diff --git a/src/gscc b/src/gscc
index 87449ee..fc0b2de 100755
--- a/src/gscc
+++ b/src/gscc
@@ -4,9 +4,11 @@
 
 
 (use-modules (ice-9 getopt-long)
+             (ice-9 popen)
              (modules lexer lexer)
              (modules parser parser)
-             (modules generator generator))
+             (modules generator generator)
+             (modules emitter emitter))
 
 
 (define version "v0.1")
@@ -21,33 +23,33 @@ Options:
         --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")))
+        --codegen, -c: perform lexing, parsing, and assembly generation, but stop before code emission\n")))
   (exit #f))
 
+(define (c-extension? file)
+  (let ((extension (string-drop file (- (string-length file) 2))))
+    (string=? extension ".c")))
+
 (define (preprocess file)
-  "Preprocesses a source file using gcc.
-Returns #f on a failure, or the name of the preprocessed
-file on a success."
-  (let ((preprocessed-file-name (tmpnam)))
-    (and
-     (zero? (system (string-concatenate `("gcc -E -P " ,file " -o " ,preprocessed-file-name))))
-     preprocessed-file-name)))
+  "Returns an input port containing FILE processed with gcc."
+  (open-input-pipe (string-append "gcc -E -P " file)))
 
-(define (process file parse? assemble?)
+(define (process port parse? generate? write?)
   "Driver for lexing, parsing, and assembly generation."
-  (let* ((port (open-input-file file))
-         (tokens (begin (set-current-input-port port)
+  (let* ((tokens (begin (set-current-input-port port)
                         (read-tokens))))
     (close-input-port port)
     (when parse?
-      (let ((ast (p-program tokens)))
-        (when assemble?
-          (display (generate ast)))))))
+      (let ((c-ast (p-program tokens)))
+        (when generate?
+          (let ((assembly-ast (g-program c-ast)))
+            (when write?
+              (e-program assembly-ast))))))))
 
-(define (postprocess file dest)
-  "Assembles and links file, producing an executable.
+(define (postprocess src dest)
+  "Assembles and links SRC, producing executable DEST.
 Returns #f on a failure, #t on a success."
-  (zero? (system (string-concatenate `("gcc " ,file " -o " ,dest)))))
+  (zero? (system (string-concatenate `("gcc " ,src " -o " ,dest)))))
 
 (define (main args)
   (let* ((option-spec
@@ -58,22 +60,31 @@ Returns #f on a failure, #t on a success."
             (codegen (single-char #\c) (value #f))))
          (options (getopt-long args option-spec))
          (rest (option-ref options '() #f))
-         (file (if (null? rest) #f (car rest))))
+         (file (if (null? rest) #f (car rest)))
+         (executable (string-drop-right file 2))
+         (assembly (string-append executable ".s")))
     (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 (equal? 'regular (stat:type (stat file))))
+          (not (c-extension? file))) (error "The file could not be read, or it is not a C source code file."))
      (#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)))))))))
-
+      (let* ((port (preprocess file))
+             (parse? (not (option-ref options 'lex #f)))
+             (generate? (not (option-ref options 'parse #f)))
+             (write? (not (option-ref options 'codegen #f)))
+             (program (process port parse? generate? write?)))
+        (when write?
+          (when (file-exists? assembly)
+            (delete-file assembly))
+          (let ((port (open-output-file assembly)))
+            (display program port)
+            (close-port port))
+          (when (postprocess assembly executable)
+            (display (string-concatenate `("Postprocess reported success (wrote " ,executable ").\n"))))))))))
 
 ;; Local Variables:
 ;; mode: scheme
diff --git a/src/modules/emitter/emitter.scm b/src/modules/emitter/emitter.scm
new file mode 100644
index 0000000..5e4b7d4
--- /dev/null
+++ b/src/modules/emitter/emitter.scm
@@ -0,0 +1,43 @@
+(define-module (modules emitter emitter)
+  #:use-module (modules ast syntax-tree)
+  #:use-module (modules ast assembly-tree)
+  #:export (e-program))
+
+
+(define emit #f)
+(define emitln #f)
+(let ((p ""))
+  (set! emit
+        (lambda (str)
+          (set! p (string-append/shared p str))
+          p))
+  (set! emitln
+        (lambda (str)
+          (emit (string-append/shared str "\n"))
+          p))
+  )
+
+(define (e-program p)
+  (e-subroutine (program-function p))
+  (emitln ".section .note.GNU-stack,\"\",@progbits"))
+
+(define (e-subroutine s)
+  (let ((label (subroutine-label s)))
+    (emitln (format #f "    .globl ~a" label))
+    (emitln (format #f "~a:" label)))
+  (e-instructions (subroutine-instructions s)))
+
+(define (e-instructions lst)
+  (unless (null? lst)
+    (begin (e-instruction (car lst))
+           (e-instructions (cdr lst)))))
+
+(define (e-instruction i)
+  (emit (format #f "    ~a" (instruction-operator i)))
+  (let ((oper1 (instruction-operand-1 i))
+        (oper2 (instruction-operand-2 i)))
+    (when oper1
+      (emit (format #f " ~a" oper1))
+      (when oper2
+        (emit (format #f ", ~a" oper2)))))
+  (emitln ""))
diff --git a/src/modules/generator/generator.scm b/src/modules/generator/generator.scm
index 4c08e32..53be252 100644
--- a/src/modules/generator/generator.scm
+++ b/src/modules/generator/generator.scm
@@ -1,30 +1,22 @@
 (define-module (modules generator generator)
   #:use-module (modules ast syntax-tree)
   #:use-module (modules ast assembly-tree)
-  #:export (generate))
+  #:export (g-program))
 
-(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))))
+  (make-program (g-function (program-function p))))
 
 (define (g-function f)
-  (make-subroutine (generate (function-id f))
-                   (generate (function-stmt f))))
+  (make-subroutine (g-id (function-id f))
+                   (g-stmt (function-stmt f))))
 
 (define (g-stmt s)
-  (generate (stmt-expr s)))
+  (g-expr (stmt-expr s)))
 
 (define (g-expr e)
   ;; for now, we assume only 'return'!
-  (list (make-instruction "mov1" "%eax" "$2")
+  (list (make-instruction "movl" (string-append/shared "$" (number->string (expr-int e))) "%eax")
         (make-instruction "ret" #f #f)))
 
 (define (g-id i)