diff --git a/pkgs/racket-doc/scribblings/reference/startup.scrbl b/pkgs/racket-doc/scribblings/reference/startup.scrbl index f9a3a89de6..564d69cccb 100644 --- a/pkgs/racket-doc/scribblings/reference/startup.scrbl +++ b/pkgs/racket-doc/scribblings/reference/startup.scrbl @@ -177,7 +177,8 @@ flags: embedded in the executable from file position @nonterm{n} to @nonterm{m} and from @nonterm{m} to @nonterm{p}. (On Mac OS X, @nonterm{n}, @nonterm{m}, and @nonterm{p} are relative to a - @tt{__PLTSCHEME} segment in the executable.) The first range + @tt{__PLTSCHEME} segment in the executable. On Windows, + they are relative to a resource of type 257 and ID 1.) The first range is loaded in every new @tech{place}, and any modules declared in that range are considered predefined in the sense of @racket[module-predefined?]. This option is normally embedded diff --git a/racket/collects/compiler/embed.rkt b/racket/collects/compiler/embed.rkt index 6f39e74d70..5bf8add8f4 100644 --- a/racket/collects/compiler/embed.rkt +++ b/racket/collects/compiler/embed.rkt @@ -17,6 +17,7 @@ "private/mach-o.rkt" "private/elf.rkt" "private/windlldir.rkt" + "private/pe-rsrc.rkt" "private/collects-path.rkt" "private/configdir.rkt" "find-exe.rkt") @@ -1582,54 +1583,76 @@ full-cmdline) (display "\0\0\0\0" out))]) (let-values ([(start decl-end end cmdline-end) - (if (and (eq? (system-type) 'macosx) - (not unix-starter?)) - ;; For Mach-O, we know how to add a proper segment - (let ([s (open-output-bytes)]) - (define decl-len (write-module s)) - (let* ([s (get-output-bytes s)] - [cl (let ([o (open-output-bytes)]) - ;; position is relative to __PLTSCHEME: - (write-cmdline (make-full-cmdline 0 decl-len (bytes-length s)) o) - (get-output-bytes o))]) - (let ([start (add-plt-segment - dest-exe - (bytes-append - s - cl))]) - (let ([start 0]) ; i.e., relative to __PLTSCHEME - (values start - (+ start decl-len) - (+ start (bytes-length s)) - (+ start (bytes-length s) (bytes-length cl))))))) - ;; Unix starter: Maybe ELF, in which case we - ;; can add a proper section - (let-values ([(s e dl p) - (if unix-starter? - (add-racket-section - orig-exe - dest-exe - (if launcher? #".rackcmdl" #".rackprog") - (lambda (start) - (let ([s (open-output-bytes)]) - (define decl-len (write-module s)) - (let ([p (file-position s)]) - (display (make-starter-cmdline - (make-full-cmdline start - (+ start decl-len) - (+ start p))) - s) - (values (get-output-bytes s) decl-len p))))) - (values #f #f #f #f))]) - (if (and s e) - ;; ELF succeeded: - (values s (+ s dl) (+ s p) e) - ;; Otherwise, just add to the end of the file: - (let ([start (file-size dest-exe)]) - (define decl-end - (call-with-output-file* dest-exe write-module - #:exists 'append)) - (values start decl-end (file-size dest-exe) #f)))))]) + (cond + [(eq? (system-type) 'windows) + ;; Add as a resource + (define o (open-output-bytes)) + (define decl-len (write-module o)) + (define init-len (bytes-length (get-output-bytes o))) + (write-cmdline (make-full-cmdline 0 decl-len init-len) o) + (define bstr (get-output-bytes o)) + (define cmdline-len (- (bytes-length bstr) init-len)) + (define-values (pe rsrcs) (call-with-input-file* + dest-exe + read-pe+resources)) + (define new-rsrcs (resource-set rsrcs + ;; Racket's "user-defined" type for excutable + ;; plus command line: + 257 + 1 + 1033 ; U.S. English + bstr)) + (update-resources dest-exe pe new-rsrcs) + (values 0 decl-len init-len (+ init-len cmdline-len))] + [(and (eq? (system-type) 'macosx) + (not unix-starter?)) + ;; For Mach-O, we know how to add a proper segment + (define s (open-output-bytes)) + (define decl-len (write-module s)) + (let* ([s (get-output-bytes s)] + [cl (let ([o (open-output-bytes)]) + ;; position is relative to __PLTSCHEME: + (write-cmdline (make-full-cmdline 0 decl-len (bytes-length s)) o) + (get-output-bytes o))]) + (let ([start (add-plt-segment + dest-exe + (bytes-append + s + cl))]) + (let ([start 0]) ; i.e., relative to __PLTSCHEME + (values start + (+ start decl-len) + (+ start (bytes-length s)) + (+ start (bytes-length s) (bytes-length cl))))))] + [else + ;; Unix starter: Maybe ELF, in which case we + ;; can add a proper section + (define-values (s e dl p) + (if unix-starter? + (add-racket-section + orig-exe + dest-exe + (if launcher? #".rackcmdl" #".rackprog") + (lambda (start) + (let ([s (open-output-bytes)]) + (define decl-len (write-module s)) + (let ([p (file-position s)]) + (display (make-starter-cmdline + (make-full-cmdline start + (+ start decl-len) + (+ start p))) + s) + (values (get-output-bytes s) decl-len p))))) + (values #f #f #f #f))) + (if (and s e) + ;; ELF succeeded: + (values s (+ s dl) (+ s p) e) + ;; Otherwise, just add to the end of the file: + (let ([start (file-size dest-exe)]) + (define decl-end + (call-with-output-file* dest-exe write-module + #:exists 'append)) + (values start decl-end (file-size dest-exe) #f)))])]) (when unix-starter? (adjust-config-dir)) (when verbose? @@ -1729,7 +1752,7 @@ (unless cmdline-done? (write-cmdline full-cmdline out)) (when long-cmdline? - ;; cmdline written at the end; + ;; cmdline written at the end, in a resource, etc.; ;; now put forwarding information at the normal cmdline pos (let ([new-end (or cmdline-end (file-position out))]) diff --git a/racket/src/racket/cmdline.inc b/racket/src/racket/cmdline.inc index c1e8d54ee4..520b641102 100644 --- a/racket/src/racket/cmdline.inc +++ b/racket/src/racket/cmdline.inc @@ -136,6 +136,126 @@ static long get_segment_offset() } #endif +#ifdef DOS_FILE_SYSTEM +wchar_t *get_self_executable_path() +{ + wchar_t *path; + DWORD r, sz = 1024; + + while (1) { + path = (wchar_t *)malloc(sz * sizeof(wchar_t)); + r = GetModuleFileNameW(NULL, path, sz); + if ((r == sz) + && (GetLastError() == ERROR_INSUFFICIENT_BUFFER)) { + free(path); + sz = 2 * sz; + } else + break; + } + + return path; +} + +static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id) +{ + DWORD got, val; + WORD name_count, id_count, i; + + SetFilePointer(fd, pos + 12, 0, FILE_BEGIN); + ReadFile(fd, &name_count, 2, &got, NULL); + ReadFile(fd, &id_count, 2, &got, NULL); + + pos += 16 + (name_count * 8); + while (id_count--) { + ReadFile(fd, &val, 4, &got, NULL); + if (val == id) { + ReadFile(fd, &val, 4, &got, NULL); + return rsrcs + (val & 0x7FFFFFF); + } else { + ReadFile(fd, &val, 4, &got, NULL); + } + } + + return 0; +} + +static long get_segment_offset() +{ + /* Find the resource of type 257 */ + wchar_t *path; + HANDLE fd; + + path = get_self_executable_path(); + fd = CreateFileW(path, GENERIC_READ, + FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, + OPEN_EXISTING, + 0, + NULL); + free(path); + + if (fd == INVALID_HANDLE_VALUE) + return 0; + else { + DWORD val, got, sec_pos, virtual_addr, rsrcs, pos; + WORD num_sections, head_size; + char name[8]; + + SetFilePointer(fd, 60, 0, FILE_BEGIN); + ReadFile(fd, &val, 4, &got, NULL); + SetFilePointer(fd, val+4+2, 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); + ReadFile(fd, &name, 8, &got, NULL); + if ((name[0] == '.') + && (name[1] == 'r') + && (name[2] == 's') + && (name[3] == 'r') + && (name[4] == 'c') + && (name[5] == 0)) { + SetFilePointer(fd, 4, 0, FILE_CURRENT); /* skip virtual size */ + 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); + + /* We're at the resource table; step through 3 layers */ + pos = find_by_id(fd, rsrcs, rsrcs, 257); + if (pos) { + pos = find_by_id(fd, rsrcs, pos, 1); + if (pos) { + pos = find_by_id(fd, rsrcs, pos, 1033); + + if (pos) { + /* pos is the reource data entry */ + SetFilePointer(fd, pos, 0, FILE_BEGIN); + ReadFile(fd, &val, 4, &got, NULL); + pos = val - virtual_addr + rsrcs; + + CloseHandle(fd); + + return pos; + } + } + } + + break; + } + sec_pos += 40; + } + + /* something went wrong */ + CloseHandle(fd); + return 0; + } +} +#endif + #ifndef DONT_PARSE_COMMAND_LINE static int is_number_arg(const char *s) { @@ -159,7 +279,7 @@ static int is_number_arg(const char *s) return 1; } -#ifdef OS_X +#if defined(OS_X) || defined(DOS_FILE_SYSTEM) char *add_to_str(const char *addr, long amt) { long addr_v; @@ -175,7 +295,7 @@ static char *make_embedded_load(const char *start, const char *end) char *s; int slen, elen; -#ifdef OS_X +#if defined(OS_X) || defined(DOS_FILE_SYSTEM) { long fileoff; fileoff = get_segment_offset(); @@ -844,17 +964,16 @@ static int run_from_cmd_line(int argc, char *_argv[], #ifdef DOS_FILE_SYSTEM if ((scheme_cmdline_exe_hack[0] == '?') || (scheme_cmdline_exe_hack[0] == '*')) { - /* This is how we make launchers in Windows. - The cmdline is appended to the end of the binary. - The long integer at scheme_cmdline_exe_hack[4] says - where the old end was, and scheme_cmdline_exe_hack[8] - says how long the cmdline string is. It might - be relative to the executable. */ - wchar_t *path; + /* This is how we make launchers in Windows. The cmdline is + added as a resource of type 257. The long integer at + scheme_cmdline_exe_hack[4] says where the command line starts + with the source, and scheme_cmdline_exe_hack[8] says how long + the cmdline string is. It might be relative to the + executable. */ HANDLE fd; + wchar_t *path; - path = (wchar_t *)malloc(1024 * sizeof(wchar_t)); - GetModuleFileNameW(NULL, path, 1024); + path = get_self_executable_path(); fd = CreateFileW(path, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, @@ -868,6 +987,7 @@ static int run_from_cmd_line(int argc, char *_argv[], DWORD got; start = *(long *)&scheme_cmdline_exe_hack[4]; len = *(long *)&scheme_cmdline_exe_hack[8]; + start += get_segment_offset(); p = (unsigned char *)malloc(len); SetFilePointer(fd, start, 0, FILE_BEGIN); ReadFile(fd, p, len, &got, NULL); @@ -916,9 +1036,10 @@ static int run_from_cmd_line(int argc, char *_argv[], + 4); } } + free(path); } #endif -#ifdef OS_X +#if defined(OS_X) if (scheme_cmdline_exe_hack[0] == '?') { long fileoff, cmdoff, cmdlen; int fd;