suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs on Windows: almost support embedded DLLs

Browse Source 
Wire in the pieces to make embedded DLLs work, but a DLL based
on Chez Scheme doesn't actually work as embedded, yet.
This commit is contained in:
Matthew Flatt 2018-12-06 16:39:28 -07:00
parent 4b42225f0c
commit beb8445d14
10 changed files with 85 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/src/cs/c/boot.c
View File

@ -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);

6
racket/src/cs/c/boot.h
View File

@ -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);

40
racket/src/cs/c/main.c
View File

@ -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
dll_path = load_delayed_dll_x(NULL, "libracketcsxxxxxxx.dll", &dll);
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);
racket_boot_p = (racket_boot_t)GetProcAddress(dll, "racket_boot");
}
boot_exe = string_to_utf8(dll_path);
racket_boot_p = (racket_boot_t)GetProcAddress(dll, "racket_boot");
# 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;
}

27
racket/src/start/config.inc
View File

@ -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

15
racket/src/start/embedded_dll.inc
View File

@ -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) {

20
racket/src/worksp/cs/Makefile
View File

@ -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)
cl /LD /DLL /Fe$(DEST_DLL) /Ox /MT $(FLAGS) $(INCS) $(CSDIR)\boot.c libracket.res $(LIBS)
$(DEST_DLL): $(CSDIR)\boot.c libracket.res $(RKTIO_LIB) $(SCHEME_LIB_FULL)
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
cl /Fe$(DEST) /Ox /MT $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\main.c racket.res $(WIN32_LIBS)
$(DEST): $(CSDIR)\main.c $(MAIN_DEPS) $(MEMMOD) $(DEST_DLL) racket.res
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

BIN
racket/src/worksp/cs/vc140.pdb Normal file
View File

Binary file not shown.

3
racket/src/worksp/csbuild.rkt
View File

@ -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)))
;; ----------------------------------------

1
racket/src/worksp/mrstart/mrstart.vcxproj
View File

@ -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>

1
racket/src/worksp/mzstart/mzstart.vcxproj
View File

@ -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>