diff --git a/cyclone.scm b/cyclone.scm index 6ab58f1e..30f26569 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -21,7 +21,8 @@ (scheme cyclone primitives) (scheme cyclone transforms) (scheme cyclone cps-optimizations) - (scheme cyclone libraries)) + (scheme cyclone libraries) + (srfi 18)) (define *fe:batch-compile* #t) ;; Batch compilation. TODO: default to false or true?? (define *optimization-level* 2) ;; Default level @@ -721,9 +722,7 @@ in-prog)) ;; Compile and emit: -(define (run-compiler args cc? cc-prog cc-exec cc-lib cc-so - cc-opts cc-prog-linker-opts cc-prog-linker-objs - append-dirs prepend-dirs) +(define (run-compiler args append-dirs prepend-dirs) (let* ((in-file (car args)) (expander (base-expander)) (in-prog-raw (read-file in-file)) @@ -754,17 +753,6 @@ " " lib-options) lib-options))) - ;; Only read C compiler options from module being compiled - (cc-opts* - (cond - (program? - (string-join ;; Check current program for options - (program-c-compiler-opts! in-prog) - " ")) - (else - (string-join - (lib:c-compiler-options (car in-prog)) - " ")))) (exec-file (basename in-file)) (src-file (string-append exec-file ".c")) (meta-file (string-append exec-file ".meta")) @@ -803,13 +791,85 @@ lib-deps) in-file append-dirs - prepend-dirs))))) - (result (create-c-file in-prog))) + prepend-dirs)))))) + (create-c-file in-prog) + (cond + (program? + ;; Use .meta file to store information for C compiler phase + (save-program-metadata meta-file lib-deps c-linker-options)) + (else + ;; Emit .meta file + (with-output-to-file + meta-file + (lambda () + (display ";; This file was automatically generated by the Cyclone Scheme compiler") + (newline) + (write (macro:get-defined-macros)))))))) +(define (save-program-metadata filename lib-deps c-linker-options) + (with-output-to-file + filename + (lambda () + (display ";; This file was automatically generated by the Cyclone Scheme compiler") + (newline) + (write `(lib-deps . ,lib-deps)) + (newline) + (write `(c-linker-options . ,c-linker-options))))) + +(define (load-program-metadata filename) + (let ((data (call-with-input-file filename read-all))) + (delete-file filename) + data)) + +(define (get-meta meta symbol default) + (if (assoc symbol meta) + (cdr (assoc symbol meta)) + default)) + +(define (run-external-compiler + args append-dirs prepend-dirs + cc? cc-prog cc-exec cc-lib cc-so + cc-opts cc-prog-linker-opts cc-prog-linker-objs) + (let* ((in-file (car args)) + (expander (base-expander)) + (in-prog-raw (read-file in-file)) + (program? (not (library? (car in-prog-raw)))) + (in-prog + (cond + (program? + (Cyc-add-feature! 'program) ;; Load special feature + ;; TODO: what about top-level cond-expands in the program? + in-prog-raw) + (else + ;; Account for any cond-expand declarations in the library + (list (lib:cond-expand (car in-prog-raw) expander))))) + ;; Only read C compiler options from module being compiled + (cc-opts* + (cond + (program? + (string-join ;; Check current program for options + (program-c-compiler-opts! in-prog) + " ")) + (else + (string-join + (lib:c-compiler-options (car in-prog)) + " ")))) + (exec-file (basename in-file)) + (src-file (string-append exec-file ".c")) + (meta-file (string-append exec-file ".meta")) + (get-comp-env + (lambda (sym str) + (if (> (string-length str) 0) + str + (Cyc-compilation-environment sym)))) + ) ;; Compile the generated C file (cond (program? - (letrec ((objs-str + (letrec ((metadata (load-program-metadata meta-file)) + (c-linker-options (get-meta metadata 'c-linker-options '())) + (lib-deps (get-meta metadata 'lib-deps '())) + (objs-str (string-append cc-prog-linker-objs (apply @@ -857,13 +917,6 @@ (display comp-objs-cmd) (newline))))) (else - ;; Emit .meta file - (with-output-to-file - meta-file - (lambda () - (display ";; This file was automatically generated by the Cyclone Scheme compiler") - (newline) - (write (macro:get-defined-macros)))) ;; Compile library (let ((comp-lib-cmd (string-append @@ -930,6 +983,8 @@ ; (equal? #\- (string-ref arg 0))))) ; args)) (compile? #t) + (run-scm-compiler? (member "-run-scm-compiler" args)) + (no-compiler-subprocess (member "-no-compiler-subprocess" args)) (cc-prog (apply string-append (collect-opt-values args "-CP"))) (cc-exec (apply string-append (collect-opt-values args "-CE"))) (cc-lib (apply string-append (collect-opt-values args "-CL"))) @@ -1073,7 +1128,28 @@ Debug options: (cdr err)) (newline) (exit 1))) - (run-compiler non-opts compile? cc-prog cc-exec cc-lib cc-so - cc-opts cc-linker-opts cc-linker-extra-objects - append-dirs prepend-dirs))))) + (cond + (run-scm-compiler? + ;; Compile Scheme code into a C file + (run-compiler non-opts append-dirs prepend-dirs)) + (else + ;; Generate the C file + (cond + (no-compiler-subprocess + ;; Special case, we can generate .C file within this process + (run-compiler non-opts append-dirs prepend-dirs)) + (else + ;; Normal path is to run another instance of cyclone to generate + ;; the .C file. This lets us immediately free those resources once + ;; the Scheme compilation is done. + (system + (string-append + (calling-program) " -run-scm-compiler " + (string-join args " "))))) + ;; Call the C compiler + (run-external-compiler + non-opts append-dirs prepend-dirs + compile? cc-prog cc-exec cc-lib cc-so + cc-opts cc-linker-opts cc-linker-extra-objects))) + ))))