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

#1290)

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 <[email protected]>

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)

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