cs on Windows: almost support embedded DLLs

Wire in the pieces to make embedded DLLs work, but a DLL based
on Chez Scheme doesn't actually work as embedded, yet.

racket/src/cs/c/boot.c

@@ -96,7 +96,8 @@ void racket_boot(int argc, char **argv, char *exec_file, char *run_file,
                  char *coldir, char *configdir, /* wchar_t * */void *dlldir,
                  int pos1, int pos2, int pos3,
                  int cs_compiled_subdir, int is_gui,
-		 int wm_is_gracket, char *gracket_guid)
+		 int wm_is_gracket, char *gracket_guid,
+		 void *dll_open, void *dll_find_object)
 /* exe argument already stripped from argv */
 {
 #if !defined(RACKET_USE_FRAMEWORK) || !defined(RACKET_AS_BOOT)
@@ -109,6 +110,8 @@ void racket_boot(int argc, char **argv, char *exec_file, char *run_file,
 #ifdef WIN32
   if (dlldir)
     rktio_set_dll_path((wchar_t *)dlldir);
+  if (dll_open)
+    rktio_set_dll_procs(dll_open, dll_find_object);
 #endif
 
   Sscheme_init(NULL);

racket/src/cs/c/boot.h

@@ -3,11 +3,13 @@ BOOT_EXTERN void racket_boot(int argc, char **argv, char *exec_file, char *run_f
 			     char *coldir, char *configdir, /* wchar_t * */void *dlldir,
 			     int pos1, int pos2, int pos3,
 			     int cs_compiled_subdir, int is_gui,
-			     int wm_is_gracket, char *gracket_guid);
+			     int wm_is_gracket, char *gracket_guid,
+			     void *ddll_open, void *dll_find_object);
 
 typedef void (*racket_boot_t)(int argc, char **argv, char *exec_file, char *run_file,
 			      char* boot_exe, long segment_offset,
 			      char *coldir, char *configdir, /* wchar_t * */void *dlldir,
 			      int pos1, int pos2, int pos3,
 			      int cs_compiled_subdir, int is_gui,
-			      int wm_is_gracket, char *gracket_guid);
+			      int wm_is_gracket, char *gracket_guid,
+			      void *ddll_open, void *dll_find_object);

racket/src/cs/c/main.c

@@ -29,6 +29,22 @@ static int scheme_utf8_encode(unsigned int *path, int zero_offset, int len,
 
 #include "../../start/config.inc"
 
+#ifdef WIN32
+typedef void *(*scheme_dll_open_proc)(const char *name, int as_global);
+typedef void *(*scheme_dll_find_object_proc)(void *h, const char *name);
+static scheme_dll_open_proc embedded_dll_open;
+static scheme_dll_find_object_proc scheme_dll_find_object;
+static void scheme_set_dll_procs(scheme_dll_open_proc open, scheme_dll_find_object_proc find)
+{
+  embedded_dll_open = open;
+  scheme_dll_find_object = find;
+}
+# include "../../start/embedded_dll.inc"
+#else
+# define embedded_dll_open NULL
+# define scheme_dll_find_object NULL
+#endif
+
 char *boot_file_data = "BooT FilE OffsetS:xxxxyyyyyzzzz";
 static int boot_file_offset = 18;
 
@@ -296,8 +312,8 @@ static int bytes_main(int argc, char **argv,
   long segment_offset;
 #ifdef WIN32
   wchar_t *dll_path;
-  HMODULE dll;
   racket_boot_t racket_boot_p;
+  long boot_rsrc_offset = 0;
 #endif
   
   do_pre_filter_cmdline_arguments(&argc, &argv);
@@ -308,10 +324,21 @@ static int bytes_main(int argc, char **argv,
   }
 
 #ifdef WIN32
-# define racket_boot racket_boot_p
+  parse_embedded_dlls();
+  register_embedded_dll_hooks();
+  if (embedded_dll_open) {
+    void *dll;
+    dll = embedded_dll_open("libracketcsxxxxxxx.dll", 1);
+    boot_rsrc_offset = in_memory_get_offset("libracketcsxxxxxxx.dll");
+    racket_boot_p = (racket_boot_t)scheme_dll_find_object(dll, "racket_boot");
+    dll_path = get_self_executable_path();
+  } else {
+    HMODULE dll;
     dll_path = load_delayed_dll_x(NULL, "libracketcsxxxxxxx.dll", &dll);
-  boot_exe = string_to_utf8(dll_path);
     racket_boot_p = (racket_boot_t)GetProcAddress(dll, "racket_boot");
+  }
+  boot_exe = string_to_utf8(dll_path);
+# define racket_boot racket_boot_p
 #else
   boot_exe = get_self_path(exec_file);
 #endif
@@ -331,7 +358,7 @@ static int bytes_main(int argc, char **argv,
   boot_offset = find_boot_section(boot_exe);
 #endif
 #ifdef WIN32
-  boot_offset = find_resource_offset(dll_path, 259);
+  boot_offset = find_resource_offset(dll_path, 259, boot_rsrc_offset);
 #endif
 
   pos1 += boot_offset;
@@ -343,7 +370,8 @@ static int bytes_main(int argc, char **argv,
               extract_coldir(), extract_configdir(), extract_dlldir(),
               pos1, pos2, pos3,
               CS_COMPILED_SUBDIR, RACKET_IS_GUI,
-	      wm_is_gracket, gracket_guid);
+	      wm_is_gracket, gracket_guid,
+	      embedded_dll_open, scheme_dll_find_object);
   
   return 0;
 }

racket/src/start/config.inc

@@ -162,12 +162,12 @@ wchar_t *get_self_executable_path() XFORM_SKIP_PROC
   return path;
 }
 
-static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id) XFORM_SKIP_PROC
+static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id, long delta) XFORM_SKIP_PROC
 {
   DWORD got, val;
   WORD name_count, id_count;
   
-  SetFilePointer(fd, pos + 12, 0, FILE_BEGIN);
+  SetFilePointer(fd, pos + 12 + delta, 0, FILE_BEGIN);
   ReadFile(fd, &name_count, 2, &got, NULL);
   ReadFile(fd, &id_count, 2, &got, NULL);
 
@@ -185,7 +185,7 @@ static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id) XFORM_SKIP_PR
   return 0;
 }
 
-static long find_resource_offset(wchar_t *path, int id) XFORM_SKIP_PROC
+static long find_resource_offset(wchar_t *path, int id, long delta) XFORM_SKIP_PROC
 {
   /* Find the resource of type `id` */
   HANDLE fd;
@@ -196,7 +196,6 @@ static long find_resource_offset(wchar_t *path, int id) XFORM_SKIP_PROC
                    OPEN_EXISTING,
                    0,
                    NULL);
-  free(path);
 
   if (fd == INVALID_HANDLE_VALUE)
     return 0;
@@ -205,16 +204,16 @@ static long find_resource_offset(wchar_t *path, int id) XFORM_SKIP_PROC
     WORD num_sections, head_size;
     char name[8];
     
-    SetFilePointer(fd, 60, 0, FILE_BEGIN);
+    SetFilePointer(fd, 60+delta, 0, FILE_BEGIN);
     ReadFile(fd, &val, 4, &got, NULL);
-    SetFilePointer(fd, val+4+2, 0, FILE_BEGIN); /* Skip "PE\0\0" tag and machine */
+    SetFilePointer(fd, val+4+2+delta, 0, FILE_BEGIN); /* Skip "PE\0\0" tag and machine */
     ReadFile(fd, &num_sections, 2, &got, NULL);
     SetFilePointer(fd, 12, 0, FILE_CURRENT); /* time stamp + symbol table */
     ReadFile(fd, &head_size, 2, &got, NULL);
 
     sec_pos = val+4+20+head_size;
     while (num_sections--) {
-      SetFilePointer(fd, sec_pos, 0, FILE_BEGIN);
+      SetFilePointer(fd, sec_pos+delta, 0, FILE_BEGIN);
       ReadFile(fd, &name, 8, &got, NULL);
       if ((name[0] == '.')
           && (name[1] == 'r')
@@ -226,24 +225,24 @@ static long find_resource_offset(wchar_t *path, int id) XFORM_SKIP_PROC
         ReadFile(fd, &virtual_addr, 4, &got, NULL);
         SetFilePointer(fd, 4, 0, FILE_CURRENT); /* skip file size */
         ReadFile(fd, &rsrcs, 4, &got, NULL);
-        SetFilePointer(fd, rsrcs, 0, FILE_BEGIN);
+        SetFilePointer(fd, rsrcs+delta, 0, FILE_BEGIN);
         
         /* We're at the resource table; step through 3 layers */
-        pos = find_by_id(fd, rsrcs, rsrcs, id);
+        pos = find_by_id(fd, rsrcs, rsrcs, id, delta);
 	if (pos) {
-	  pos = find_by_id(fd, rsrcs, pos, 1);
+	  pos = find_by_id(fd, rsrcs, pos, 1, delta);
 	  if (pos) {
-	    pos = find_by_id(fd, rsrcs, pos, 1033);
+	    pos = find_by_id(fd, rsrcs, pos, 1033, delta);
 
 	    if (pos) {
 	      /* pos is the reource data entry */
-	      SetFilePointer(fd, pos, 0, FILE_BEGIN);
+	      SetFilePointer(fd, pos+delta, 0, FILE_BEGIN);
 	      ReadFile(fd, &val, 4, &got, NULL);
 	      pos = val - virtual_addr + rsrcs;
 
 	      CloseHandle(fd);
 
-	      return pos;
+	      return pos+delta;
 	    }
 	  }
 	}
@@ -261,7 +260,7 @@ static long find_resource_offset(wchar_t *path, int id) XFORM_SKIP_PROC
 
 static long get_segment_offset() XFORM_SKIP_PROC
 {
-  return find_resource_offset(get_self_executable_path(), 257);
+  return find_resource_offset(get_self_executable_path(), 257, 0);
 }
 
 #endif

racket/src/start/embedded_dll.inc

@@ -38,7 +38,7 @@ static void parse_embedded_dlls()
 {
   long rsrc_pos;
 
-  rsrc_pos = find_resource_offset(get_self_executable_path(), 258);
+  rsrc_pos = find_resource_offset(get_self_executable_path(), 258, 0);
   if (rsrc_pos) {
     HANDLE fd = open_self();
     
@@ -140,6 +140,19 @@ static void *in_memory_find_object(void *h, const char *name)
   }
 }
 
+static long in_memory_get_offset(const char *name)
+{
+  int i;
+
+  for (i = 0; embedded_dlls[i].name; i++) {
+    if (!_stricmp(embedded_dlls[i].name, name)) {
+      return embedded_dlls[i].pos;
+    }
+  }
+  
+  return 0;
+}
+
 static void register_embedded_dll_hooks()
 {
   if (embedded_dlls) {

racket/src/worksp/cs/Makefile

@@ -4,9 +4,10 @@ INCS = /I.. /I..\..\rktio /I..\librktio /I$(SCHEME_DIR)\$(MACHINE)\boot\$(MACHIN
 RKTIO_LIB = ..\..\build\librktio.lib
 BASE_WIN32_LIBS = WS2_32.lib Shell32.lib User32.lib
 WIN32_LIBS = $(BASE_WIN32_LIBS) RpCrt4.lib Ole32.lib Advapi32.lib
+SCHEME_LIB_FULL = $(SCHEME_DIR)\$(MACHINE)\boot\$(MACHINE)\$(SCHEME_LIB)
 
 LIBS = $(RKTIO_LIB) \
-       $(SCHEME_DIR)\$(MACHINE)\boot\$(MACHINE)\$(SCHEME_LIB) \
+       $(SCHEME_LIB_FULL) \
        $(WIN32_LIBS)
 
 DEST_DLL = ..\..\build\raw_libracketcs.dll
@@ -17,27 +18,30 @@ CSDIR = ..\..\cs\c
 MAIN_DEPS = ..\..\start\config.inc \
             ..\..\start\parse_cmdl.inc \
             ..\..\start\delayed.inc \
-            ..\..\start\win_single.inc
+            ..\..\start\win_single.inc \
+            ..\..\start\embedded_dll.inc
 
-FLAGS = /DWIN32
+MEMMOD = ..\..\start\MemoryModule.c
+
+FLAGS = /DWIN32 /Ox /MT
 COMP_SUBDIR = /DCS_COMPILED_SUBDIR=1
 
 all: $(DEST) $(GDEST)
 
-$(DEST_DLL): $(CSDIR)\boot.c libracket.res $(RKTIO_LIB)
+$(DEST_DLL): $(CSDIR)\boot.c libracket.res $(RKTIO_LIB) $(SCHEME_LIB_FULL)
-	cl /LD /DLL /Fe$(DEST_DLL) /Ox /MT $(FLAGS) $(INCS) $(CSDIR)\boot.c libracket.res $(LIBS)
+	cl /LD /DLL /Fe$(DEST_DLL) $(FLAGS) $(INCS) $(CSDIR)\boot.c libracket.res $(LIBS)
 
 libracket.res: libracket.rc
 	rc /l 0x409 /folibracket.res libracket.rc
 
-$(DEST): $(CSDIR)\main.c $(MAIN_DEPS) $(DEST_DLL) racket.res
+$(DEST): $(CSDIR)\main.c $(MAIN_DEPS) $(MEMMOD) $(DEST_DLL) racket.res
-	cl /Fe$(DEST) /Ox /MT $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\main.c racket.res $(WIN32_LIBS)
+	cl /Fe$(DEST) $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\main.c $(MEMMOD) 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)\main.c $(MAIN_DEPS) $(DEST_DLL) gracket.res
-	cl /Fe$(GDEST) /Ox /MT $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\grmain.c gracket.res $(WIN32_LIBS)
+	cl /Fe$(GDEST) $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\grmain.c $(MEMMOD) gracket.res $(WIN32_LIBS)
 
 gracket.res: ../gracket/gracket.rc ../gracket/gracket.ico
 	rc /l 0x409 /fogracket.res ../gracket/gracket.rc

racket/src/worksp/csbuild.rkt

@@ -103,7 +103,8 @@
 (prep-chez-scheme scheme-dir machine)
 
 (parameterize ([current-directory (build-path scheme-dir machine "c")])
-  (system*! "nmake" (format "Makefile.~a" machine)))
+  (system*! "nmake"
+	    (format "Makefile.~a" machine)))
 
 ;; ----------------------------------------
 

racket/src/worksp/mrstart/mrstart.vcxproj

@@ -38,6 +38,7 @@
   <PropertyGroup Label="UserMacros" />
   <PropertyGroup>
     <_ProjectFileVersion>10.0.40219.1</_ProjectFileVersion>
+    <TargetName>MrStart</TargetName>
     <OutDir>..\..\..\lib\</OutDir>
     <IntDir>$(Platform)\$(Configuration)\</IntDir>
     <LinkIncremental>false</LinkIncremental>

racket/src/worksp/mzstart/mzstart.vcxproj

@@ -38,6 +38,7 @@
   <PropertyGroup Label="UserMacros" />
   <PropertyGroup>
     <_ProjectFileVersion>10.0.40219.1</_ProjectFileVersion>
+    <TargetName>MzStart</TargetName>
     <OutDir>..\..\..\lib\</OutDir>
     <IntDir>$(Platform)\$(Configuration)\</IntDir>
     <LinkIncremental>false</LinkIncremental>