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

fix places pipe for Windows

Browse Source 
And also fix int-vs-ptr mismatches for the pipe layer
that is also used by `subprocess'
This commit is contained in:
Matthew Flatt 2011-09-16 06:36:07 -06:00
parent e637806306
commit d173879f39
3 changed files with 89 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/racket/src/place.c
View File

@ -211,7 +211,7 @@ Scheme_Object *scheme_make_place_object() {
return (Scheme_Object *)place_obj;
}
static void close_six_fds(int *rw) {
static void close_six_fds(intptr_t *rw) {
int i;
for (i=0; i<6; i++) { if (rw[i] >= 0) scheme_close_file_fd(rw[i]); }
}
@ -246,7 +246,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
Scheme_Object *in_arg;
Scheme_Object *out_arg;
Scheme_Object *err_arg;
int rw[6] = {-1, -1, -1, -1, -1, -1};
intptr_t rw[6] = {-1, -1, -1, -1, -1, -1};
/* To avoid runaway place creation, check for termination before continuing. */
scheme_thread_block(0.0);
@ -306,7 +306,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
}
if (SCHEME_PAIRP(args[0]) && SAME_OBJ(SCHEME_CAR(args[0]), quote_symbol)) {
scheme_arg_mismatch("dynamic-place", "dynamic-place works on only on filesystem module-paths", args[0]);
scheme_arg_mismatch("dynamic-place", "not only a filesystem module-path: ", args[0]);
}
so = places_deep_copy_to_master(args[0]);
@ -349,7 +349,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
}
rw[0] = tmpfd;
}
else if (pipe(rw)) {
else if (scheme_os_pipe(rw, -1)) {
errorno = scheme_errno();
close_six_fds(rw);
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, "pipe: error creating place standard input streams (%e)", errorno);
@ -365,7 +365,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
}
rw[3] = tmpfd;
}
else if (pipe(rw + 2)) {
else if (scheme_os_pipe(rw + 2, -1)) {
errorno = scheme_errno();
close_six_fds(rw);
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, "pipe: error creating place standard output streams (%e)", errorno);
@ -381,7 +381,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
}
rw[5] = tmpfd;
}
else if (pipe(rw + 4)) {
else if (scheme_os_pipe(rw + 4, -1)) {
errorno = scheme_errno();
close_six_fds(rw);
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, "pipe: error creating place standard error streams (%e)", errorno);

100
src/racket/src/port.c
View File

@ -7298,14 +7298,14 @@ scheme_make_fd_output_port(int fd, Scheme_Object *name, int regfile, int textmod
#define MZ_FAILURE_STATUS -1
#ifdef PROCESS_FUNCTION
#if defined(PROCESS_FUNCTION) || defined(MZ_USE_PLACES)
# define USE_CREATE_PIPE
#ifdef WINDOWS_PROCESSES
# ifdef USE_CREATE_PIPE
# define _EXTRA_PIPE_ARGS
static int MyPipe(int *ph, int near_index) {
static int MyPipe(intptr_t *ph, int near_index) {
HANDLE r, w;
SECURITY_ATTRIBUTES saAttr;
@ -7320,6 +7320,7 @@ static int MyPipe(int *ph, int near_index) {
a[0] = r;
a[1] = w;
if (near_index != -1) {
/* Change the near end to make it non-inheritable, then
close the inheritable one: */
if (!DuplicateHandle(GetCurrentProcess(), a[near_index],
@ -7333,6 +7334,7 @@ static int MyPipe(int *ph, int near_index) {
CloseHandle(a[near_index]);
a[near_index] = naya;
}
}
ph[0] = (long)a[0];
ph[1] = (long)a[1];
@ -7342,17 +7344,34 @@ static int MyPipe(int *ph, int near_index) {
return 1;
}
# define PIPE_FUNC MyPipe
# define PIPE_HANDLE_t intptr_t
# else
# include <Process.h>
# include <fcntl.h>
# define PIPE_FUNC(pa, nearh) MSC_IZE(pipe)(pa)
# define PIPE_HANDLE_t int
# define _EXTRA_PIPE_ARGS , 256, _O_BINARY
# endif
#else
# define _EXTRA_PIPE_ARGS
# define PIPE_FUNC(pa, nearh) MSC_IZE(pipe)(pa)
# define PIPE_HANDLE_t int
#endif
int scheme_os_pipe(intptr_t *a, int nearh)
/* If nearh != -1, then the handle at the index
other than nearh is made inheritable so that
a subprocess can use it. */
{
PIPE_HANDLE_t la[2];
if (PIPE_FUNC(la, nearh _EXTRA_PIPE_ARGS))
return 1;
a[0] = la[0];
a[1] = la[1];
return 0;
}
#endif
/**************** Unix: signal stuff ******************/
@ -8080,7 +8099,7 @@ static char *cmdline_protect(char *s)
}
static intptr_t mz_spawnv(char *command, const char * const *argv,
int exact_cmdline, int sin, int sout, int serr, int *pid,
int exact_cmdline, intptr_t sin, intptr_t sout, intptr_t serr, int *pid,
int new_process_group)
{
int i, l, len = 0;
@ -8190,8 +8209,8 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
const char *name = "subprocess";
#if defined(PROCESS_FUNCTION) && !defined(MAC_CLASSIC_PROCESS_CONTROL)
char *command;
int to_subprocess[2], from_subprocess[2], err_subprocess[2];
int i, pid;
intptr_t to_subprocess[2], from_subprocess[2], err_subprocess[2];
int i, pid, errid;
char **argv;
Scheme_Object *in, *out, *err;
#if defined(UNIX_PROCESSES)
@ -8370,38 +8389,41 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
/* Create needed pipes */
/*--------------------------------------*/
if (!inport && PIPE_FUNC(to_subprocess, 1 _EXTRA_PIPE_ARGS)) {
if (!inport && scheme_os_pipe(to_subprocess, 1)) {
errid = scheme_errno();
if (outport) { mzCLOSE_FILE_HANDLE(from_subprocess, 1); }
if (errport) { mzCLOSE_FILE_HANDLE(err_subprocess, 1); }
scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errno);
scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errid);
}
if (!outport && PIPE_FUNC(from_subprocess, 0 _EXTRA_PIPE_ARGS)) {
if (!outport && scheme_os_pipe(from_subprocess, 0)) {
errid = scheme_errno();
if (!inport) {
MSC_IZE(close)(to_subprocess[0]);
MSC_IZE(close)(to_subprocess[1]);
scheme_close_file_fd(to_subprocess[0]);
scheme_close_file_fd(to_subprocess[1]);
} else {
mzCLOSE_FILE_HANDLE(to_subprocess, 0);
}
if (errport) { mzCLOSE_FILE_HANDLE(err_subprocess, 1); }
scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errno);
scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errid);
}
if (!errport && stderr_is_stdout) {
err_subprocess[0] = from_subprocess[0];
err_subprocess[1] = from_subprocess[1];
} else if (!errport && PIPE_FUNC(err_subprocess, 0 _EXTRA_PIPE_ARGS)) {
} else if (!errport && scheme_os_pipe(err_subprocess, 0)) {
errid = scheme_errno();
if (!inport) {
MSC_IZE(close)(to_subprocess[0]);
MSC_IZE(close)(to_subprocess[1]);
scheme_close_file_fd(to_subprocess[0]);
scheme_close_file_fd(to_subprocess[1]);
} else {
mzCLOSE_FILE_HANDLE(to_subprocess, 0);
}
if (!outport) {
MSC_IZE(close)(from_subprocess[0]);
MSC_IZE(close)(from_subprocess[1]);
scheme_close_file_fd(from_subprocess[0]);
scheme_close_file_fd(from_subprocess[1]);
} else {
mzCLOSE_FILE_HANDLE(from_subprocess, 1);
}
scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errno);
scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errid);
}
#if defined(WINDOWS_PROCESSES)
@ -8443,7 +8465,6 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
sc = (void *)spawn_status;
}
# define mzCLOSE_PIPE_END(x) CloseHandle((HANDLE)(x))
#else
@ -8540,21 +8561,21 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
case -1:
/* Close unused descriptors. */
if (!inport) {
MSC_IZE(close)(to_subprocess[0]);
MSC_IZE(close)(to_subprocess[1]);
scheme_close_file_fd(to_subprocess[0]);
scheme_close_file_fd(to_subprocess[1]);
} else {
mzCLOSE_FILE_HANDLE(to_subprocess, 0);
}
if (!outport) {
MSC_IZE(close)(from_subprocess[0]);
MSC_IZE(close)(from_subprocess[1]);
scheme_close_file_fd(from_subprocess[0]);
scheme_close_file_fd(from_subprocess[1]);
} else {
mzCLOSE_FILE_HANDLE(from_subprocess, 1);
}
if (!errport) {
if (!stderr_is_stdout) {
MSC_IZE(close)(err_subprocess[0]);
MSC_IZE(close)(err_subprocess[1]);
scheme_close_file_fd(err_subprocess[0]);
scheme_close_file_fd(err_subprocess[1]);
}
} else {
mzCLOSE_FILE_HANDLE(err_subprocess, 1);
@ -8566,23 +8587,29 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
{
/* Copy pipe descriptors to stdin and stdout */
MSC_IZE(dup2)(to_subprocess[0], 0);
MSC_IZE(dup2)(from_subprocess[1], 1);
MSC_IZE(dup2)(err_subprocess[1], 2);
do {
errid = MSC_IZE(dup2)(to_subprocess[0], 0);
} while (errid == -1 && errno == EINTR);
do {
errid = MSC_IZE(dup2)(from_subprocess[1], 1);
} while (errid == -1 && errno == EINTR);
do {
errid = MSC_IZE(dup2)(err_subprocess[1], 2);
} while (errid == -1 && errno == EINTR);
/* Close unwanted descriptors. */
if (!inport) {
MSC_IZE(close)(to_subprocess[0]);
MSC_IZE(close)(to_subprocess[1]);
scheme_close_file_fd(to_subprocess[0]);
scheme_close_file_fd(to_subprocess[1]);
}
if (!outport) {
MSC_IZE(close)(from_subprocess[0]);
MSC_IZE(close)(from_subprocess[1]);
scheme_close_file_fd(from_subprocess[0]);
scheme_close_file_fd(from_subprocess[1]);
}
if (!errport) {
if (!stderr_is_stdout) {
MSC_IZE(close)(err_subprocess[0]);
MSC_IZE(close)(err_subprocess[1]);
scheme_close_file_fd(err_subprocess[0]);
scheme_close_file_fd(err_subprocess[1]);
}
}
@ -8649,7 +8676,6 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
break;
}
# define mzCLOSE_PIPE_END(x) MSC_IZE(close)(x)
#endif
/*--------------------------------------*/
@ -8657,14 +8683,14 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
/*--------------------------------------*/
if (!inport) {
mzCLOSE_PIPE_END(to_subprocess[0]);
scheme_close_file_fd(to_subprocess[0]);
out = NULL;
} else {
mzCLOSE_FILE_HANDLE(to_subprocess, 0);
out = scheme_false;
}
if (!outport) {
mzCLOSE_PIPE_END(from_subprocess[1]);
scheme_close_file_fd(from_subprocess[1]);
in = NULL;
} else {
mzCLOSE_FILE_HANDLE(from_subprocess, 1);
@ -8672,7 +8698,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
}
if (!errport) {
if (!stderr_is_stdout)
mzCLOSE_PIPE_END(err_subprocess[1]);
scheme_close_file_fd(err_subprocess[1]);
err = NULL;
} else {
mzCLOSE_FILE_HANDLE(err_subprocess, 1);

1
src/racket/src/schpriv.h
View File

@ -3727,6 +3727,7 @@ intptr_t scheme_dup_socket(intptr_t fd);
intptr_t scheme_dup_file(intptr_t fd);
void scheme_close_socket_fd(intptr_t fd);
void scheme_close_file_fd(intptr_t fd);
int scheme_os_pipe(intptr_t *fds, int near_index);
void scheme_tcp_abandon_port(Scheme_Object *port);
intptr_t scheme_socket_errno();
intptr_t scheme_errno();