cs Windows: move kernel and boot files to DLL

racket/collects/setup/winvers-change.rkt

@@ -15,7 +15,7 @@
 (define binary-extensions '("exe" "dll" "lib" "so" "def" "exp" #|"obj" "o"|#))
 (define xxxs #"xxxxxxx")
 (define xxxs-re
-  (bytes-append #"(?:lib(?:g?racket|mzgc)(?:|3m))(" xxxs #")"))
+  (bytes-append #"(?:lib(?:g?racket|mzgc)(?:|3m|cs))(" xxxs #")"))
 (define renaming (regexp (format "^~a[.](?:dll|lib|exp|def)$" xxxs-re)))
 (define substitutions
   (map (lambda (s) (byte-regexp (regexp-replace #rx#"~a" s xxxs-re)))

racket/src/cs/c/boot.c

@@ -1,4 +1,4 @@
-#ifndef _MSC_VER
+#ifndef WIN32
 # include <unistd.h>
 #endif
 #include <stdio.h>
@@ -7,6 +7,12 @@
 #include <stdlib.h>
 #include "scheme.h"
 #include "rktio.h"
+
+#ifdef WIN32
+# define BOOT_EXTERN __declspec(dllexport)
+#else
+# define BOOT_EXTERN extern
+#endif
 #include "boot.h"
 
 #define RACKET_AS_BOOT
@@ -78,7 +84,8 @@ static void init_foreign()
   Sforeign_symbol("racket_exit", (void *)racket_exit);
 }
 
-void racket_boot(int argc, char **argv, char *self, long segment_offset,
+void racket_boot(int argc, char **argv, char *self,
+		 char *boot_exe, long segment_offset,
                  char *coldir, char *configdir,
                  int pos1, int pos2, int pos3,
                  int cs_compiled_subdir, int is_gui)
@@ -101,7 +108,7 @@ void racket_boot(int argc, char **argv, char *self, long segment_offset,
   Sregister_boot_file(path_append(fw_path, "racket.boot"));
 # endif
 #else
-  fd = open(self, O_RDONLY | BOOT_O_BINARY);
+  fd = open(boot_exe, O_RDONLY | BOOT_O_BINARY);
 
   {
     int fd1, fd2;
@@ -110,12 +117,12 @@ void racket_boot(int argc, char **argv, char *self, long segment_offset,
     lseek(fd1, pos1, SEEK_SET);    
     Sregister_boot_file_fd("petite", fd1);
     
-    fd2 = open(self, O_RDONLY | BOOT_O_BINARY);
+    fd2 = open(boot_exe, O_RDONLY | BOOT_O_BINARY);
     lseek(fd2, pos2, SEEK_SET);
     Sregister_boot_file_fd("scheme", fd2);
 
 # ifdef RACKET_AS_BOOT
-    fd = open(self, O_RDONLY | BOOT_O_BINARY);
+    fd = open(boot_exe, O_RDONLY | BOOT_O_BINARY);
     lseek(fd, pos3, SEEK_SET);
     Sregister_boot_file_fd("racket", fd);
 # endif

racket/src/cs/c/boot.h

@@ -1,4 +1,11 @@
-void racket_boot(int argc, char **argv, char *self, long segment_offset,
+BOOT_EXTERN void racket_boot(int argc, char **argv, char *self,
+			     char *boot_exe, long segment_offset,
+			     char *coldir, char *configdir,
+			     int pos1, int pos2, int pos3,
+			     int cs_compiled_subdir, int is_gui);
+
+typedef void (*racket_boot_t)(int argc, char **argv, char *self,
+			      char* boot_exe, long segment_offset,
 			      char *coldir, char *configdir,
 			      int pos1, int pos2, int pos3,
 			      int cs_compiled_subdir, int is_gui);

racket/src/cs/c/embed-boot.rkt

@@ -2,10 +2,12 @@
 (require racket/cmdline
          racket/file
          compiler/private/mach-o
+         compiler/private/pe-rsrc
          compiler/private/elf
          "adjust-compress.rkt")
 
 (define expect-elf? #f)
+(define alt-dests '())
 
 (command-line
  #:once-each
@@ -13,6 +15,9 @@
   (enable-compress!)]
  [("--expect-elf") "Record offset from ELF section"
   (set! expect-elf? #t)]
+ #:multi
+ [("++exe") src dest "Select an alternative executable"
+  (set! alt-dests (cons (cons src dest) alt-dests))]
  #:args (src-file dest-file boot-dir racket.boot)
 
  (define bstr1 (adjust-compress (file->bytes (build-path boot-dir "petite.boot"))))
@@ -39,6 +44,20 @@
         ;; Mach-O
         (copy-file src-file dest-file #t)
         (add-plt-segment dest-file data #:name #"__RKTBOOT")]
+       [("win32\\x86_64" "win32\\i386")
+        (copy-file src-file dest-file #t)
+        (define-values (pe rsrcs) (call-with-input-file*
+                                   dest-file
+                                   read-pe+resources))
+        (define new-rsrcs (resource-set rsrcs
+                                        ;; Racket's "user-defined" type for boot:
+                                        259
+                                        1
+                                        1033 ; U.S. English
+                                        data))
+	(update-resources dest-file pe new-rsrcs)
+	;; Find resource at run time:
+	0]
        [else
         ;; ELF?
         (define-values (start-pos end-pos any1 any2)
@@ -76,6 +95,7 @@
              (error 'embed-boot "expected ELF"))
            pos])]))
 
+   (define (write-offsets dest-file)
      (define-values (i o) (open-input-output-file dest-file #:exists 'update))
      (define m (regexp-match-positions #rx"BooT FilE OffsetS:" i))
      (unless m
@@ -86,4 +106,14 @@
      (file-position o (cdar m))
      (void (write-bytes (integer->integer-bytes pos 4 #t #f) o))
      (void (write-bytes (integer->integer-bytes (+ pos (bytes-length bstr1) terminator-len) 4 #t #f) o))
-   (void (write-bytes (integer->integer-bytes (+ pos (bytes-length bstr1) (bytes-length bstr2) (* 2 terminator-len)) 4 #t #f) o))))
+     (void (write-bytes (integer->integer-bytes (+ pos (bytes-length bstr1) (bytes-length bstr2) (* 2 terminator-len)) 4 #t #f) o)))
+
+   (cond
+    [(null? alt-dests)
+     (write-offsets dest-file)]
+    [else
+     (for ([alt (in-list alt-dests)])
+	  (copy-file (car alt) (cdr alt) #t)
+	  (write-offsets (cdr alt)))])))
+     
+ 

racket/src/cs/c/main.c

@@ -10,6 +10,7 @@
 static int scheme_utf8_encode(unsigned int *path, int zero_offset, int len,
 			      char *dest, int dest_len, int get_utf16);
 #endif
+#define BOOT_EXTERN extern
 #include "boot.h"
 
 #define MZ_CHEZ_SCHEME
@@ -125,10 +126,9 @@ static long find_boot_section(char *me)
 #endif
 
 
-#ifdef _MSC_VER
+#ifdef WIN32
-static char *get_self_path()
+static char *path_to_utf8(wchar_t *p)
 {
-  wchar_t *p = get_self_executable_path();
   char *r;
   int len;
 
@@ -139,6 +139,11 @@ static char *get_self_path()
   return r;
 }
 
+static char *get_self_path()
+{
+  return path_to_utf8(get_self_executable_path());
+}
+
 static int scheme_utf8_encode(unsigned int *path, int zero_offset, int len,
 			      char *dest, int dest_len, int get_utf16)
 {
@@ -159,9 +164,15 @@ static long get_segment_offset()
 
 int main(int argc, char **argv)
 {
-  char *self, *prog = argv[0], *sprog = NULL;
+  char *self, *boot_exe, *prog = argv[0], *sprog = NULL;
   int pos1, pos2, pos3;
+  long boot_offset;
   long segment_offset;
+#ifdef WIN32
+  wchar_t *dll_path;
+  HMODULE dll;
+  racket_boot_t racket_boot_p;
+#endif
   
   do_pre_filter_cmdline_arguments(&argc, &argv);
 
@@ -173,21 +184,33 @@ int main(int argc, char **argv)
 
   self = get_self_path();
 
+#ifdef WIN32
+# define racket_boot racket_boot_p
+  dll_path = load_delayed_dll_x(NULL, "libracketcsxxxxxxx.dll", &dll);
+  boot_exe = path_to_utf8(dll_path);
+  racket_boot_p = (racket_boot_t)GetProcAddress(dll, "racket_boot");
+#else
+  boot_exe = self;
+#endif
+
   memcpy(&pos1, boot_file_data + boot_file_offset, sizeof(pos1));
   memcpy(&pos2, boot_file_data + boot_file_offset + 4, sizeof(pos2));
   memcpy(&pos3, boot_file_data + boot_file_offset + 8, sizeof(pos2));
 
+  boot_offset = 0;
 #ifdef ELF_FIND_BOOT_SECTION
-  {
-    long boot_offset;
   boot_offset = find_boot_section(self);
+#endif
+#ifdef WIN32
+  boot_offset = find_resource_offset(dll_path, 259);
+#endif
+
   pos1 += boot_offset;
   pos2 += boot_offset;
   pos3 += boot_offset;
-  }
-#endif
 
-  racket_boot(argc, argv, self, segment_offset,
+  racket_boot(argc, argv, self,
+	      boot_exe, segment_offset,
               extract_coldir(), extract_configdir(),
               pos1, pos2, pos3,
               CS_COMPILED_SUBDIR, RACKET_IS_GUI);

racket/src/start/config.inc

@@ -185,13 +185,11 @@ static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id) XFORM_SKIP_PR
   return 0;
 }
 
-static long find_resource_offset(int id) XFORM_SKIP_PROC
+static long find_resource_offset(wchar_t *path, int id) XFORM_SKIP_PROC
 {
   /* Find the resource of type `id` */
-  wchar_t *path;
   HANDLE fd;
 
-  path = get_self_executable_path();
   fd = CreateFileW(path, GENERIC_READ,
                    FILE_SHARE_READ | FILE_SHARE_WRITE,
                    NULL,
@@ -263,7 +261,7 @@ static long find_resource_offset(int id) XFORM_SKIP_PROC
 
 static long get_segment_offset() XFORM_SKIP_PROC
 {
-  return find_resource_offset(257);
+  return find_resource_offset(get_self_executable_path(), 257);
 }
 
 #endif

racket/src/start/delayed.inc

@@ -23,7 +23,7 @@ static int _dlldir_offset = 14; /* Skip permanent tag */
 START_XFORM_SKIP;
 # endif
 
-static void load_delayed_dll(HINSTANCE me, const char *lib) 
+static wchar_t *load_delayed_dll_x(HINSTANCE me, const char *lib, HMODULE *_loaded) 
 {
   /* Don't use the C library here! */
   const wchar_t *dlldir = _dlldir + _dlldir_offset;
@@ -63,6 +63,7 @@ static void load_delayed_dll(HINSTANCE me, const char *lib)
     {
       wchar_t *t;
       int j, i;
+      HMODULE loaded;
 
       t = (wchar_t *)GlobalAlloc(GMEM_FIXED, 2048 * sizeof(wchar_t));
       for (i = 0; dlldir[i]; i++) {
@@ -75,10 +76,19 @@ static void load_delayed_dll(HINSTANCE me, const char *lib)
       }
       t[i] = 0;
 
-      if (!LoadLibraryW(t)) {
+      loaded = LoadLibraryW(t);
+      if (!loaded) {
 	MessageBoxW(NULL, t, L"Failure: cannot load DLL", MB_OK);
 	ExitProcess(1);
       }
+
+      if (_loaded) *_loaded = loaded;
+      return t;
     }
   }
 }
+
+static void load_delayed_dll(HINSTANCE me, const char *lib)
+{
+  (void)load_delayed_dll_x(me, lib, NULL);
+}

racket/src/worksp/cs/.gitignore

@@ -1 +1,3 @@
+libracket.res
 racket.res
+gracket.res

racket/src/worksp/cs/Makefile

@@ -9,6 +9,7 @@ LIBS = $(RKTIO_LIB) \
        $(SCHEME_DIR)\$(MACHINE)\boot\$(MACHINE)\$(SCHEME_LIB) \
        $(WIN32_LIBS)
 
+DEST_DLL = ..\..\build\raw_libracketcs.dll
 DEST = ..\..\build\raw_racketcs.exe
 GDEST = ..\..\build\raw_gracketcs.exe
 CSDIR = ..\..\cs\c
@@ -18,14 +19,20 @@ COMP_SUBDIR = /DCS_COMPILED_SUBDIR=1
 
 all: $(DEST) $(GDEST)
 
-$(DEST): $(CSDIR)\main.c $(CSDIR)\boot.c racket.res $(RKTIO_LIB)
+$(DEST_DLL): $(CSDIR)\boot.c libracket.res $(RKTIO_LIB)
-	cl /Fe$(DEST) /Ox /MT $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\main.c $(CSDIR)\boot.c racket.res $(LIBS)
+	cl /LD /DLL /Fe$(DEST_DLL) /Ox /MT $(FLAGS) $(INCS) $(CSDIR)\boot.c libracket.res $(LIBS)
+
+libracket.res: libracket.rc
+	rc /l 0x409 /folibracket.res libracket.rc
+
+$(DEST): $(CSDIR)\main.c $(DEST_DLL) racket.res
+	cl /Fe$(DEST) /Ox /MT $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\main.c racket.res $(WIN32_LIBS)
 
 racket.res: ../racket/racket.rc ../racket/racket.ico
 	rc /l 0x409 /foracket.res ../racket/racket.rc
 
-$(GDEST): $(CSDIR)\grmain.c $(CSDIR)\boot.c gracket.res $(RKTIO_LIB)
+$(GDEST): $(CSDIR)\grmain.c $(DEST_DLL) gracket.res
-	cl /Fe$(GDEST) /Ox /MT $(COMP_SUBDIR) $(INCS) $(FLAGS) $(CSDIR)\grmain.c $(CSDIR)\boot.c gracket.res $(LIBS) /subsystem:windows
+	cl /Fe$(GDEST) /Ox /MT $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\grmain.c gracket.res $(WIN32_LIBS) /subsystem:windows
 
 gracket.res: ../gracket/gracket.rc ../gracket/gracket.ico
 	rc /l 0x409 /fogracket.res ../gracket/gracket.rc

racket/src/worksp/cs/libracket.rc

@@ -0,0 +1,40 @@
+#include <windows.h>
+#include "../../racket/src/schvers.h"
+
+/////////////////////////////////////////////////////////////////////////////
+//
+// Version
+//
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION MZSCHEME_VERSION_X,MZSCHEME_VERSION_Y,MZSCHEME_VERSION_Z,MZSCHEME_VERSION_W
+ PRODUCTVERSION MZSCHEME_VERSION_X,MZSCHEME_VERSION_Y,MZSCHEME_VERSION_Z,MZSCHEME_VERSION_W
+ FILEFLAGSMASK 0x3fL
+#ifdef _DEBUG
+ FILEFLAGS 0x1L
+#else
+ FILEFLAGS 0x0L
+#endif
+ FILEOS 0x40004L
+ FILETYPE 0x1L
+ FILESUBTYPE 0x0L
+BEGIN
+    BLOCK "StringFileInfo"
+    BEGIN
+        BLOCK "040904b0"
+        BEGIN
+            VALUE "CompanyName", "Racket\0"
+            VALUE "FileDescription", "Racket implementation\0"
+            VALUE "InternalName", "Racket\0"
+            VALUE "FileVersion", MZSCHEME_VERSION "\0"
+            VALUE "LegalCopyright", "Copyright 1995-2016 Racket\0"
+            VALUE "OriginalFilename", "racket.dll\0"
+            VALUE "ProductName", "Racket\0"
+            VALUE "ProductVersion", MZSCHEME_VERSION "\0"
+        END
+    END
+    BLOCK "VarFileInfo"
+    BEGIN
+        VALUE "Translation", 0x409, 1200
+    END
+END

racket/src/worksp/csbuild.rkt

@@ -193,22 +193,16 @@
 	  "../build/racket.so"
 	  "../build/racket.boot")
 
-(define (embed-boot src dest)
+(system*! (find-exe)
-  (system*! (find-exe)
           "-O" "info@compiler/cm"
           "-l-" "setup" boot-mode "../setup-go.rkt" "..//build/compiled"
           "ignored" "../build/ignored.d"
           "../cs/c/embed-boot.rkt"
-            src
+	  "++exe" "../build/raw_racketcs.exe" (format "../../Racket~a.exe" cs-suffix)
-            dest
+	  "++exe" "../build/raw_gracketcs.exe" (format "../../lib/GRacket~a.exe" cs-suffix)
+          "../build/raw_libracketcs.dll" "../../lib/libracketcsxxxxxxx.dll"
           (build-path scheme-dir machine "boot" machine)
-            "../build/racket.boot"))
+          "../build/racket.boot")
-
-(embed-boot "../build/raw_racketcs.exe"
-            (format "../../Racket~a.exe" cs-suffix))
-
-(embed-boot "../build/raw_gracketcs.exe"
-            (format "../../lib/GRacket~a.exe" cs-suffix))
 
 ;; ----------------------------------------
 ;; Finish installation with "mzstart", "mrstart", and other