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

cs: fix raco exe for OpenBSD

Browse Source 
The repair involvea adding a `-E` flag to Racket for use by the wrap
executable that `raco exe` created, because OpenBSD (intentionally)
does not have a way to access the executable file of the current
process.

Closes #3717
This commit is contained in:
Matthew Flatt 2021-03-07 05:03:50 -07:00
parent a3bf702ac9
commit fac8463082
6 changed files with 48 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-doc/scribblings/reference/startup.scrbl
View File

@ -333,6 +333,11 @@ flags:
by @racket[(find-system-path 'run-file)] to
@nonterm{file}.}
@item{@FlagFirst{E} @nonterm{file} or @DFlagFirst{exe}
@nonterm{file} : sets the name of the executable as reported
by @racket[(find-system-path 'exec-file)] to
@nonterm{file}.}
@item{@FlagFirst{J} @nonterm{name} or @DFlagFirst{wm-class}
@nonterm{name} : GRacket, Unix only; sets the @tt{WM_CLASS}
program class to @nonterm{name} (while the @tt{WM_CLASS}
@ -467,7 +472,8 @@ Extra arguments following the last option are available from the
@history[#:changed "6.90.0.17" @elem{Added @Flag{O}/@DFlag{stdout}.}
#:changed "7.1.0.5" @elem{Added @Flag{M}/@DFlag{compile-any}.}
#:changed "7.8.0.6" @elem{Added @Flag{Z}.}]
#:changed "7.8.0.6" @elem{Added @Flag{Z}.}
#:changed "8.0.0.10" @elem{Added @Flag{E}.}]
@; ----------------------------------------------------------------------

11
racket/src/bc/cmdline.inc
View File

@ -768,6 +768,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
argv[0] = "-m";
else if (!strcmp("--name", argv[0]))
argv[0] = "-N";
else if (!strcmp("--exec", argv[0]))
argv[0] = "-E";
else if (!strcmp("--no-compiled", argv[0]))
argv[0] = "-c";
else if (!strcmp("--no-lib", argv[0]))
@ -1017,6 +1019,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
eval_kind[num_enl++] = mzcmd_EMBEDDED;
break;
case 'N':
case 'E':
if (argc < 2) {
PRINTF("%s: missing name after %s switch\n",
prog,
@ -1025,13 +1028,16 @@ static int run_from_cmd_line(int argc, char *_argv[],
}
argv++;
--argc;
sprog = argv[0];
if (!*sprog) {
if (!*(argv[0])) {
PRINTF("%s: empty path after %s switch\n",
prog,
real_switch);
goto show_need_help;
}
if (*str == 'N')
sprog = argv[0];
else
prog = argv[0];
was_config_flag = 1;
break;
case 'q':
@ -1439,6 +1445,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
" -R <paths>, --compiled <paths> : Set compiled-file search roots to <paths>\n"
" -C, --cross : Cross-build mode; save current collects and config as host\n"
" -N <file>, --name <file> : Sets `(find-system-path 'run-file)' to <file>\n"
" -E <file>, --exec <file> : Sets `(find-system-path 'exec-file)' to <file>\n"
# ifdef CMDLINE_STDIO_FLAG
" -J <name>, ---wm-class <name> : Set WM_CLASS class to <name> (Unix)\n"
# endif

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

@ -172,7 +172,7 @@ static char *get_self_path(char *exec_file)
# undef USE_GENERIC_GET_SELF_PATH
#endif
#if defined(__FreeBSD__)
#if defined(__FreeBSD__) || defined(__NetBSD__)
# include <sys/sysctl.h>
# include <errno.h>
static char *get_self_path(char *exec_file)
@ -183,9 +183,15 @@ static char *get_self_path(char *exec_file)
int r;
mib[0] = CTL_KERN;
#if defined(__NetBSD__)
mib[1] = KERN_PROC_ARGS;
mib[2] = getpid();
mib[3] = KERN_PROC_PATHNAME;
#else
mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PATHNAME;
mib[3] = -1;
#endif
r = sysctl(mib, 4, NULL, &len, NULL, 0);
if (r < 0) {

20
racket/src/cs/main.sps
View File

@ -277,8 +277,8 @@
[else
(values (car args) (append (reverse accum) (cdr args)))])))
(define (check-path-arg what flag within-flag)
(when (equal? what "")
(define (check-path-arg path what flag within-flag)
(when (equal? path "")
(startup-error "empty ~a after ~a switch" what (or within-flag flag))))
(define (raise-bad-switch arg within-arg)
@ -363,6 +363,7 @@
(let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)])
(add-namespace-require-load! `(file ,file-name) file-name)
(no-init! saw)
(check-path-arg file-name "file name" arg within-arg)
(set-run-file! (string->path file-name))
(flags-loop (cons "--" rest-args) (see saw 'non-config 'lib)))]
[("-f" "--load")
@ -374,6 +375,7 @@
(let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)])
(set! loads (cons (lambda () (load file-name))
loads))
(check-path-arg file-name "file name" arg within-arg)
(set-run-file! (string->path file-name))
(flags-loop (cons "--" rest-args) (see saw 'non-config)))]
[("-e" "--eval")
@ -458,18 +460,18 @@
(cond
[(equal? collects-path "")
(set! init-collects-dir 'disable)]
[else
(check-path-arg "collects path" arg within-arg)
[else
(check-path-arg collects-path "collects path" arg within-arg)
(set! init-collects-dir (path->complete-path (->path (find-original-bytes collects-path))))])
(loop rest-args))]
[("-S" "--search")
(let-values ([(collects-path rest-args) (next-arg "path" arg within-arg args)])
(check-path-arg "collects path" collects-path within-arg)
(check-path-arg collects-path "collects path" collects-path within-arg)
(set! rev-collects-post-extra (cons (->path (find-original-bytes collects-path)) rev-collects-post-extra))
(loop rest-args))]
[("-G" "--config")
(let-values ([(config-path rest-args) (next-arg "config path" arg within-arg args)])
(check-path-arg "config path" config-path within-arg)
(check-path-arg config-path "config path" config-path within-arg)
(set! init-config-dir (path->complete-path (->path (find-original-bytes config-path))))
(loop rest-args))]
[("-C" "--cross")
@ -506,8 +508,14 @@
(loop rest-args))]
[("-N" "--name")
(let-values ([(name rest-args) (next-arg "name" arg within-arg args)])
(check-path-arg name "name" arg within-arg)
(set-run-file! (string->path name))
(loop rest-args))]
[("-E" "--exec")
(let-values ([(name rest-args) (next-arg "name" arg within-arg args)])
(check-path-arg name "name" arg within-arg)
(set-exec-file! (string->path name))
(loop rest-args))]
[("-J")
(cond
[gracket?

3
racket/src/cs/main/help.ss
View File

@ -51,7 +51,8 @@
" -U, --no-user-path : Ignore user-specific collects, etc.\n"
" -R <paths>, --compiled <paths> : Set compiled-file search roots to <paths>\n"
" -C, --cross : Cross-build mode; save current collects and config as host\n"
" -N <file>, --name <file> : Sets `(find-system-path 'run-file)' to <file>\n"))
" -N <file>, --name <file> : Sets `(find-system-path 'run-file)' to <file>\n"
" -E <file>, --exec <file> : Sets `(find-system-path 'exec-file)' to <file>\n"))
(when gracket?
(#%printf
" -J <name>, ---wm-class <name> : Set WM_CLASS class to <name> (Unix)\n"))

11
racket/src/start/ustart.c
View File

@ -456,7 +456,7 @@ int main(int argc, char **argv)
}
data = (char *)malloc(end - prog_end);
new_argv = (char **)malloc((count + argc + (2 * collcount) + 10) * sizeof(char*));
new_argv = (char **)malloc((count + argc + (2 * collcount) + 12) * sizeof(char*));
fd = open(me, O_RDONLY, 0);
lseek(fd, prog_end, SEEK_SET);
@ -495,11 +495,18 @@ int main(int argc, char **argv)
putenv(dll_path);
}
new_argv[0] = me;
new_argv[0] = exe_path;
argpos = 1;
inpos = 1;
/* Add -E flag; we can't just put `me` in `argv[0]`, because some
OSes (well, just OpenBSD) cannot find the executable path of a
process, and the actual executable may be needed to find embedded
boot images. */
new_argv[argpos++] = "-E";
new_argv[argpos++] = me;
/* Keep all X11 flags to the front: */
if (x11) {
int n;