From 5fdd83ac19e2c5ab315f3a9f8b7aa97c79c46e42 Mon Sep 17 00:00:00 2001 From: bd Date: Mon, 30 Dec 2024 18:25:43 -0700 Subject: Implement assembly emission, allowing execution of trivial programs Rewrite preprocess to return an input port rather than a temporary file. --- README.org | 6 ++-- src/gscc | 65 ++++++++++++++++++++++--------------- src/modules/emitter/emitter.scm | 43 ++++++++++++++++++++++++ src/modules/generator/generator.scm | 20 ++++-------- 4 files changed, 91 insertions(+), 43 deletions(-) create mode 100644 src/modules/emitter/emitter.scm diff --git a/README.org b/README.org index 650f6a4..d79da6a 100644 --- a/README.org +++ b/README.org @@ -8,11 +8,13 @@ It is written solely using tools distributed with Guile. ** TODO Important - [ ] Reasonable parser error messages +- [X] Rewrite deprecated temporary file generation method +- [X] Cleanup temp files after process end - [ ] More parenthesis -** TODO Features [0/19] +** TODO Features [1/19] -- [ ] Trivial Programs +- [X] Trivial Programs - [ ] Unary Operators - [ ] Binary Operators - [ ] Logical and Relational Operators 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) -- cgit v1.2.3