Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Preliminary native windows support, part 1: building bach with MSVC… #1290

Merged
merged 2 commits into from
Jan 8, 2025
Merged

Preliminary native windows support, part 1: building bach with MSVC… #1290

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
e4718f5
Preliminary native windows support, part 1: building `bach` with MSVC…
Jan 3, 2025
40340f8
Improve code and add comments
Jan 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
63 changes: 52 additions & 11 deletions src/build/build-bach.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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"
Expand Down Expand Up @@ -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")
Expand All @@ -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|)"
Expand All @@ -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)
Expand Down
48 changes: 35 additions & 13 deletions src/gerbil/compiler/driver.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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))))
Expand Down Expand Up @@ -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))
Expand All @@ -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
Expand Down Expand Up @@ -393,17 +415,17 @@ 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))
(deps (filter (? (not file-empty?)) deps))
(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)))
Expand Down
Loading