Preliminary native windows support, part 1: building bach with MSVC (sys-type: visualc)

Author: Rujia Liu

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,39 @@
   (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")))
+
+(def (path->string-literal path)
+  (string-append
+    "\""
+    (string-map
+      (lambda (c) (if (char=? c #\\) #\/ c))
+      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"
@@ -109,15 +142,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-o (map (cut replace-extension <> compiler-obj-suffix) 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-o (replace-extension bach-main-scm compiler-obj-suffix))
        (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 "\")"))
+        (string-append "(include " (path->string-literal gambit-sharp) ")"))
        (gsc-gx-macros
         (if (gerbil-runtime-smp?)
           ["-e" "(define-cond-expand-feature|enable-smp|)"
@@ -141,18 +174,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,19 @@ namespace: gxc
    (cond-expand (darwin "-Wl,-rpath,") (else "-Wl,-rpath="))
    gerbil-libdir))
 
+(def compiler-obj-suffix
+  (cond-expand
+    (visualc ".obj")
+    (else ".o")))
+
+(def (path->string-literal path)
+  (string-append
+    "\""
+    (string-map
+      (lambda (c) (if (char=? c #\\) #\/ c))
+      path)
+    "\""))
+
 (def gerbil-runtime-modules
   '("gerbil/runtime/gambit"
     "gerbil/runtime/util"
@@ -222,23 +235,23 @@ namespace: gxc
            (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-o      (map (cut replace-extension <> compiler-obj-suffix) 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-o       (map (cut replace-extension <> compiler-obj-suffix) 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-o        (replace-extension src-bin-scm compiler-obj-suffix))
            (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-o         (replace-extension output-scm compiler-obj-suffix))
            (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 +265,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 +406,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 (string-append "(include " (path->string-literal 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)))