Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-15 08:47:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch '268-dev'

Browse source
This commit is contained in:
Justin Ethier 2021-08-26 13:17:25 -04:00
commit 00a7c2e372
1 changed files with 104 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

132
cyclone.scm
View file

@ -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)))
))))