diff --git a/collects/compiler/start.ss b/collects/compiler/start.ss index ad67e4bdf0..5bf279c4fb 100644 --- a/collects/compiler/start.ss +++ b/collects/compiler/start.ss @@ -31,7 +31,8 @@ (lib "compile.ss" "dynext") (lib "link.ss" "dynext") (lib "pack.ss" "setup") - (lib "getinfo.ss" "setup")) + (lib "getinfo.ss" "setup") + (lib "plthome.ss" "setup")) (define dest-dir (make-parameter #f)) (define auto-dest-dir (make-parameter #f)) @@ -117,6 +118,11 @@ (extract-suffix append-object-suffix) (extract-suffix append-extension-suffix)) "extension")] + [("--xform") + ,(lambda (f) 'xform) + (,(format "Convert for 3m compilation: ~a -> ~a" + (extract-suffix append-c-suffix) + (extract-suffix append-c-suffix)))] [("--exe") ,(lambda (f name) (exe-output name) 'exe) (,(format "Embed module in MzScheme to create ") @@ -231,6 +237,24 @@ (printf "C linker libraries: ~s~n" (expand-for-link-variant (current-standard-link-libraries)))) ("Show C linker libraries")]] + [multi + [("++cppf") + ,(lambda (f v) (current-extension-preprocess-flags + (append (current-extension-preprocess-flags) + (list v)))) + ("Add C preprocess (xform) flag" "flag")] + [("--cppf") + ,(lambda (f v) (current-extension-preprocess-flags + (remove v (current-extension-preprocess-flags)))) + ("Remove C preprocess (xform) flag" "flag")] + [("--cppf-clear") + ,(lambda (f) (current-extension-preprocess-flags null)) + ("Clear C preprocess (xform) flags")] + [("--cppf-show") + ,(lambda (f) + (printf "C compiler flags: ~s~n" (expand-for-link-variant + (current-extension-preprocess-flags)))) + ("Show C preprocess (xform) flags")]] [help-labels "--------------------- executable configuration flags ------------------------"] [once-each @@ -455,6 +479,16 @@ source-files dest) (printf " [output to \"~a\"]~n" dest))] + [(xform) + (for-each (lambda (file) + (let ([out-file (path-replace-suffix file ".3m.c")]) + ((dynamic-require '(lib "xform.ss" "compiler") 'xform) + (not (compiler:option:verbose)) + file + out-file + (list (build-path plthome "include"))) + (printf " [output to \"~a\"]~n" out-file))) + source-files)] [(exe gui-exe) (unless (= 1 (length source-files)) (error 'mzc "expected a single module source file to embed; given: ~e" diff --git a/collects/compiler/xform.ss b/collects/compiler/xform.ss index b4b62dbcc9..703569f349 100644 --- a/collects/compiler/xform.ss +++ b/collects/compiler/xform.ss @@ -12,7 +12,7 @@ [headers (apply append (map (current-make-compile-include-strings) header-dirs))]) - (xform:xform #f + (xform:xform quiet? (cons exe (append flags headers)) src diff --git a/collects/dynext/compile-sig.ss b/collects/dynext/compile-sig.ss index 867dbfb331..dfb63fb005 100644 --- a/collects/dynext/compile-sig.ss +++ b/collects/dynext/compile-sig.ss @@ -6,6 +6,7 @@ (define-signature dynext:compile^ (compile-extension + preprocess-extension current-extension-compiler current-extension-compiler-flags current-extension-preprocess-flags diff --git a/collects/dynext/compile-unit.ss b/collects/dynext/compile-unit.ss index e9a7f02bdc..10840a8df7 100644 --- a/collects/dynext/compile-unit.ss +++ b/collects/dynext/compile-unit.ss @@ -248,7 +248,7 @@ (lambda (start-process quiet?) (do-stdio start-process quiet? (lambda (s) (error 'compile-extension "~a" s))))))) - (define unix/windows-compile + (define (make-compile-extension current-extension-compiler-flags) (lambda (quiet? in out includes) (let ([c (current-extension-compiler)]) (if c @@ -270,14 +270,8 @@ (apply my-process* command))) quiet?) (error 'compile-extension "can't find an installed C compiler"))))) - - (include (build-path "private" "macinc.ss")) - - (define (macos-compile quiet? input-file output-file includes) - (macos-make 'compile-extension "extension-project" "lib" quiet? - (list input-file) output-file includes)) - - (define compile-extension - (case (system-type) - [(unix windows macosx) unix/windows-compile] - [(macos) macos-compile]))))) + + (define compile-extension (make-compile-extension + current-extension-compiler-flags)) + (define preprocess-extension (make-compile-extension + current-extension-compiler-flags)))))