From a3161a553309a9b932e2abd490ed21e080e8400a Mon Sep 17 00:00:00 2001 From: Rujia Liu <5819633+rujialiu@users.noreply.github.com> Date: Wed, 8 Jan 2025 17:55:17 +0800 Subject: [PATCH] =?UTF-8?q?Preliminary=20native=20windows=20support,=20par?= =?UTF-8?q?t=201:=20building=20`bach`=20with=20MSVC=E2=80=A6=20(#1290)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is part 1 with minimal changes. Maybe some utilities should be moved elsewhere but I don't know what's the best place, so I just keep things together for easier review. This change will be enough to build `bach`, but batch scripts are not included yet. --------- Co-authored-by: Rujia Liu --- src/build/build-bach.ss | 63 +++++++++++++++++++++++++++++------ src/gerbil/compiler/driver.ss | 48 ++++++++++++++++++-------- 2 files changed, 87 insertions(+), 24 deletions(-) diff --git a/src/build/build-bach.ss b/src/build/build-bach.ss index 18ac42a7d..774c17f43 100644 --- a/src/build/build-bach.ss +++ b/src/build/build-bach.ss @@ -13,7 +13,10 @@ (getenv "GERBIL_GSC" default-gerbil-gsc)) (def (gerbil-gcc) - (getenv "GERBIL_GCC" "gcc")) + (getenv "GERBIL_GCC" + (cond-expand + (visualc "cl") + (else "gcc")))) (def gerbil-bindir (path-expand "bin" build-home)) @@ -28,9 +31,42 @@ (def default-ld-options ["-lutil" "-lm"])) (netbsd (def default-ld-options ["-lm"])) + (visualc + (def default-ld-options ["Kernel32.Lib" "User32.Lib" "Gdi32.Lib" "WS2_32.Lib" "/subsystem:console" "/entry:WinMainCRTStartup"])) (else (def default-ld-options ["-ldl" "-lm"]))) +(def compiler-obj-suffix + (cond-expand + (visualc ".obj") + (else ".o"))) + +; generates an `include` form for use in a source code, gsc's -e option etc. +; It takes care of windows paths where we need to escape the path. +; e.g. (displayln (include-source "d:\\gerbil\\mycode.scm")) should print +; (include "d:\\gerbil\\mycode.scm") +; instead of: +; (include "d:\gerbil\mycode.scm") +; which results in an error: +; *** ERROR -- Invalid escaped character: #\g +(def (include-source path) + (string-append "(include " (object->string path) ")")) + +(def (link-output-options output-bin) + (cond-expand + (visualc [(string-append "/Fe" output-bin)]) + (else ["-o" output-bin]))) + +(def (link-with-libgambit-options) + (cond-expand + (visualc ["/link" (string-append "/LIBPATH:" "\"" gerbil-libdir "\"") "libgambit.lib"]) + (else ["-L" gerbil-libdir "-lgambit"]))) + +(def compiler-debug-option + (cond-expand + (visualc "/Zi") + (else "-g"))) + (def builtin-modules '(;; :gerbil/runtime "gerbil/runtime/gambit" @@ -98,6 +134,12 @@ (def (replace-extension path ext) (string-append (path-strip-extension path) ext)) +(def (replace-extension-with-c path) + (replace-extension path ".c")) + +(def (replace-extension-with-object path) + (replace-extension path compiler-obj-suffix)) + ;; first compile the module (displayln "... compile " bach-main) (compile-module (string-append bach-main ".ss") @@ -108,16 +150,15 @@ ;; and then compile the binary (let* ((builtin-modules-scm (map static-file-name builtin-modules)) - (builtin-modules-c (map (cut replace-extension <> ".c") builtin-modules-scm)) - (builtin-modules-o (map (cut replace-extension <> ".o") builtin-modules-scm)) + (builtin-modules-c (map replace-extension-with-c builtin-modules-scm)) + (builtin-modules-o (map replace-extension-with-object builtin-modules-scm)) (bach-main-scm (static-file-name bach-main)) - (bach-main-c (replace-extension bach-main-scm ".c")) - (bach-main-o (replace-extension bach-main-scm ".o")) + (bach-main-c (replace-extension-with-c bach-main-scm)) + (bach-main-o (replace-extension-with-object bach-main-scm)) (bach-link-c (path-expand "gerbil-link.c" gerbil-libdir)) - (bach-link-o (replace-extension bach-link-c ".o")) + (bach-link-o (replace-extension bach-link-c compiler-obj-suffix)) (gambit-sharp (path-expand "_gambit#.scm" gerbil-libdir)) - (include-gambit-sharp - (string-append "(include \"" gambit-sharp "\")")) + (include-gambit-sharp (include-source gambit-sharp)) (gsc-gx-macros (if (gerbil-runtime-smp?) ["-e" "(define-cond-expand-feature|enable-smp|)" @@ -141,18 +182,18 @@ bach-main-scm]) (for-each (lambda (path-c) (add-compile-job! - (lambda () (invoke (gerbil-gsc) ["-obj" "-cc-options" "-g" path-c])) + (lambda () (invoke (gerbil-gsc) ["-obj" "-cc-options" compiler-debug-option path-c])) `(compile ,path-c))) [builtin-modules-c ... bach-main-c bach-link-c]) (execute-pending-compile-jobs!) (displayln "... build " output-bin) (invoke (gerbil-gcc) - ["-o" output-bin + [(link-output-options output-bin) ... rpath-options ... builtin-modules-o ... bach-main-o bach-link-o - "-L" gerbil-libdir "-lgambit" + (link-with-libgambit-options) ... default-ld-options ...]) ;; clean up (delete-file bach-main-scm) diff --git a/src/gerbil/compiler/driver.ss b/src/gerbil/compiler/driver.ss index 66a4ff329..34ef4b5e6 100644 --- a/src/gerbil/compiler/driver.ss +++ b/src/gerbil/compiler/driver.ss @@ -58,6 +58,22 @@ namespace: gxc (cond-expand (darwin "-Wl,-rpath,") (else "-Wl,-rpath=")) gerbil-libdir)) +(def compiler-obj-suffix + (cond-expand + (visualc ".obj") + (else ".o"))) + +; generates an `include` form for use in a source code, gsc's -e option etc. +; It takes care of windows paths where we need to escape the path. +; e.g. (displayln (include-source "d:\\gerbil\\mycode.scm")) should print +; (include "d:\\gerbil\\mycode.scm") +; instead of: +; (include "d:\gerbil\mycode.scm") +; which results in an error: +; *** ERROR -- Invalid escaped character: #\g +(def (include-source path) + (string-append "(include " (object->string path) ")")) + (def gerbil-runtime-modules '("gerbil/runtime/gambit" "gerbil/runtime/util" @@ -174,6 +190,12 @@ namespace: gxc (def (replace-extension path ext) (string-append (path-strip-extension path) ext)) + (def (replace-extension-with-c path) + (replace-extension path ".c")) + + (def (replace-extension-with-object path) + (replace-extension path compiler-obj-suffix)) + (def (userlib-module? ctx) (and (not (exclude-module? ctx)) (not (libgerbil-module? ctx)))) @@ -221,24 +243,24 @@ namespace: gxc (libgerbil-deps (filter libgerbil-module? deps)) (libgerbil-scm (map find-static-module-file libgerbil-deps)) (libgerbil-scm (fold-libgerbil-runtime-scm gerbil-staticdir libgerbil-scm)) - (libgerbil-c (map (cut replace-extension <> ".c") libgerbil-scm)) - (libgerbil-o (map (cut replace-extension <> ".o") libgerbil-scm)) + (libgerbil-c (map replace-extension-with-c libgerbil-scm)) + (libgerbil-o (map replace-extension-with-object libgerbil-scm)) (src-deps (filter userlib-module? deps)) (src-deps-scm (map find-static-module-file src-deps)) (src-deps-scm (filter not-file-empty? src-deps-scm)) (src-deps-scm (map path-expand src-deps-scm)) - (src-deps-c (map (cut replace-extension <> ".c") src-deps-scm)) - (src-deps-o (map (cut replace-extension <> ".o") src-deps-scm)) + (src-deps-c (map replace-extension-with-c src-deps-scm)) + (src-deps-o (map replace-extension-with-object src-deps-scm)) (src-bin-scm (find-static-module-file ctx)) (src-bin-scm (path-expand src-bin-scm)) - (src-bin-c (replace-extension src-bin-scm ".c")) - (src-bin-o (replace-extension src-bin-scm ".o")) + (src-bin-c (replace-extension-with-c src-bin-scm)) + (src-bin-o (replace-extension-with-object src-bin-scm)) (output-bin (path-expand output-bin)) (output-scm (path-expand output-scm)) - (output-c (replace-extension output-scm ".c")) - (output-o (replace-extension output-scm ".o")) + (output-c (replace-extension-with-c output-scm)) + (output-o (replace-extension-with-object output-scm)) (output_-c (replace-extension output-scm "_.c")) - (output_-o (replace-extension output-scm "_.o")) + (output_-o (replace-extension output-scm (string-append "_" compiler-obj-suffix))) (gsc-link-opts (gsc-link-options)) (gsc-cc-opts (gsc-cc-options static: #t)) (gsc-static-opts (gsc-static-include-options gerbil-staticdir)) @@ -252,7 +274,7 @@ namespace: gxc (cons ctx deps)))))) (def (compile-obj scm-path c-path) - (let (o-path (replace-extension c-path ".o")) + (let (o-path (replace-extension c-path compiler-obj-suffix)) (let* ((lock (string-append o-path ".lock")) (locked #f) (unlock @@ -393,7 +415,7 @@ namespace: gxc (gerbil-libdir (path-expand "lib" gerbil-home)) (runtime (map find-static-module-file gerbil-runtime-modules)) (gambit-sharp (path-expand "lib/_gambit#.scm" gerbil-home)) - (include-gambit-sharp (string-append "(include \"" gambit-sharp "\")")) + (include-gambit-sharp (include-source gambit-sharp)) (bin-scm (find-static-module-file ctx)) (deps (find-runtime-module-deps ctx)) (deps (map find-static-module-file deps)) @@ -401,9 +423,9 @@ namespace: gxc (deps (filter (lambda (f) (not (member f runtime))) deps)) (output-base (string-append (path-strip-extension output-scm))) (output-c (string-append output-base ".c")) - (output-o (string-append output-base ".o")) + (output-o (string-append output-base compiler-obj-suffix)) (output-c_ (string-append output-base "_.c")) - (output-o_ (string-append output-base "_.o")) + (output-o_ (string-append output-base (string-append "_" compiler-obj-suffix))) (gsc-link-opts (gsc-link-options)) (gsc-cc-opts (gsc-cc-options static: #t)) (gsc-static-opts (gsc-static-include-options (path-expand "static" gerbil-libdir)))