diff options
Diffstat (limited to 'src/gscc')
-rwxr-xr-x | src/gscc | 65 |
1 files changed, 38 insertions, 27 deletions
@@ -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 |