From a24c6fe4f9abbda4773ee25756fa0918ebe28ee9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 28 Oct 2018 08:15:03 -0700 Subject: [PATCH] cs Windows: move kernel and boot files to DLL --- racket/collects/setup/winvers-change.rkt | 2 +- racket/src/cs/c/boot.c | 17 +++++--- racket/src/cs/c/boot.h | 15 ++++++-- racket/src/cs/c/embed-boot.rkt | 48 ++++++++++++++++++----- racket/src/cs/c/main.c | 49 +++++++++++++++++------- racket/src/start/config.inc | 6 +-- racket/src/start/delayed.inc | 14 ++++++- racket/src/worksp/cs/.gitignore | 2 + racket/src/worksp/cs/Makefile | 15 ++++++-- racket/src/worksp/cs/libracket.rc | 40 +++++++++++++++++++ racket/src/worksp/csbuild.rkt | 26 +++++-------- 11 files changed, 176 insertions(+), 58 deletions(-) create mode 100644 racket/src/worksp/cs/libracket.rc diff --git a/racket/collects/setup/winvers-change.rkt b/racket/collects/setup/winvers-change.rkt index 1904e1c3c2..8321295212 100644 --- a/racket/collects/setup/winvers-change.rkt +++ b/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))) diff --git a/racket/src/cs/c/boot.c b/racket/src/cs/c/boot.c index 16f73fe560..37d768e279 100644 --- a/racket/src/cs/c/boot.c +++ b/racket/src/cs/c/boot.c @@ -1,4 +1,4 @@ -#ifndef _MSC_VER +#ifndef WIN32 # include #endif #include @@ -7,6 +7,12 @@ #include #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 diff --git a/racket/src/cs/c/boot.h b/racket/src/cs/c/boot.h index d8d95bd21f..e7d322a1c7 100644 --- a/racket/src/cs/c/boot.h +++ b/racket/src/cs/c/boot.h @@ -1,4 +1,11 @@ -void racket_boot(int argc, char **argv, char *self, long segment_offset, - char *coldir, char *configdir, - int pos1, int pos2, int pos3, - int cs_compiled_subdir, int is_gui); +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); diff --git a/racket/src/cs/c/embed-boot.rkt b/racket/src/cs/c/embed-boot.rkt index 6425813b5d..a085da5a24 100644 --- a/racket/src/cs/c/embed-boot.rkt +++ b/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,14 +95,25 @@ (error 'embed-boot "expected ELF")) pos])])) - (define-values (i o) (open-input-output-file dest-file #:exists 'update)) - (define m (regexp-match-positions #rx"BooT FilE OffsetS:" i)) - (unless m - (error 'embed-boot "cannot file boot-file offset tag")) + (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 + (error 'embed-boot "cannot file boot-file offset tag")) - (define terminator-len (bytes-length terminator)) + (define terminator-len (bytes-length terminator)) + + (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))) - (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)))) + (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)))]))) + + diff --git a/racket/src/cs/c/main.c b/racket/src/cs/c/main.c index db449202a1..e55d470870 100644 --- a/racket/src/cs/c/main.c +++ b/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 -static char *get_self_path() +#ifdef WIN32 +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,10 +164,16 @@ 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); argc--; @@ -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); - pos1 += boot_offset; - pos2 += boot_offset; - pos3 += boot_offset; - } + boot_offset = find_boot_section(self); +#endif +#ifdef WIN32 + boot_offset = find_resource_offset(dll_path, 259); #endif - racket_boot(argc, argv, self, segment_offset, + pos1 += boot_offset; + pos2 += boot_offset; + pos3 += boot_offset; + + racket_boot(argc, argv, self, + boot_exe, segment_offset, extract_coldir(), extract_configdir(), pos1, pos2, pos3, CS_COMPILED_SUBDIR, RACKET_IS_GUI); diff --git a/racket/src/start/config.inc b/racket/src/start/config.inc index 4c28f0fbfc..eccd2530de 100644 --- a/racket/src/start/config.inc +++ b/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 diff --git a/racket/src/start/delayed.inc b/racket/src/start/delayed.inc index ef81e30fba..4710b30130 100644 --- a/racket/src/start/delayed.inc +++ b/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); +} diff --git a/racket/src/worksp/cs/.gitignore b/racket/src/worksp/cs/.gitignore index b423f2cd56..a865282cb2 100644 --- a/racket/src/worksp/cs/.gitignore +++ b/racket/src/worksp/cs/.gitignore @@ -1 +1,3 @@ +libracket.res racket.res +gracket.res diff --git a/racket/src/worksp/cs/Makefile b/racket/src/worksp/cs/Makefile index eb7c895a7d..95deb300c7 100644 --- a/racket/src/worksp/cs/Makefile +++ b/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) - cl /Fe$(DEST) /Ox /MT $(COMP_SUBDIR) $(FLAGS) $(INCS) $(CSDIR)\main.c $(CSDIR)\boot.c racket.res $(LIBS) +$(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) + +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) - cl /Fe$(GDEST) /Ox /MT $(COMP_SUBDIR) $(INCS) $(FLAGS) $(CSDIR)\grmain.c $(CSDIR)\boot.c gracket.res $(LIBS) /subsystem:windows +$(GDEST): $(CSDIR)\grmain.c $(DEST_DLL) gracket.res + 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 diff --git a/racket/src/worksp/cs/libracket.rc b/racket/src/worksp/cs/libracket.rc new file mode 100644 index 0000000000..0172fb9cf4 --- /dev/null +++ b/racket/src/worksp/cs/libracket.rc @@ -0,0 +1,40 @@ +#include +#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 diff --git a/racket/src/worksp/csbuild.rkt b/racket/src/worksp/csbuild.rkt index 48f7141496..30333fa33f 100644 --- a/racket/src/worksp/csbuild.rkt +++ b/racket/src/worksp/csbuild.rkt @@ -193,22 +193,16 @@ "../build/racket.so" "../build/racket.boot") -(define (embed-boot src dest) - (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 - dest - (build-path scheme-dir machine "boot" machine) - "../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)) +(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" + "++exe" "../build/raw_racketcs.exe" (format "../../Racket~a.exe" cs-suffix) + "++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") ;; ---------------------------------------- ;; Finish installation with "mzstart", "mrstart", and other