mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-13 04:42:13 -08:00
Preliminary version of RUN-PROCESS
This commit is contained in:
jjgarcia
parent
da9a2697cf
commit
428c31794f
5 changed files with 134 additions and 43 deletions
33
src/c/file.d
33
src/c/file.d
|
|
@ -1864,6 +1864,39 @@ cl_interactive_stream_p(cl_object strm)
|
|||
@(return output)
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm)
|
||||
{
|
||||
cl_object stream;
|
||||
char *mode; /* file open mode */
|
||||
FILE *fp; /* file pointer */
|
||||
|
||||
switch(smm) {
|
||||
case smm_input:
|
||||
mode = "r";
|
||||
break;
|
||||
case smm_output:
|
||||
mode = "w";
|
||||
break;
|
||||
default:
|
||||
FEerror("make_stream: wrong mode", 0);
|
||||
}
|
||||
fp = fdopen(fd, mode);
|
||||
|
||||
stream = cl_alloc_object(t_stream);
|
||||
stream->stream.mode = (short)smm;
|
||||
stream->stream.file = fp;
|
||||
stream->stream.object0 = @'base-char';
|
||||
stream->stream.object1 = fname; /* not really used */
|
||||
stream->stream.int0 = stream->stream.int1 = 0;
|
||||
#if !defined(GBC_BOEHM)
|
||||
fp->_IO_buf_base = NULL; /* BASEFF */;
|
||||
setbuf(fp, stream->stream.buffer = cl_alloc_atomic(BUFSIZ));
|
||||
#endif
|
||||
return(stream);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
init_file(void)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1454,6 +1454,8 @@ cl_symbols[] = {
|
|||
{MP_ "WITHOUT-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
|
||||
#endif
|
||||
|
||||
{EXT_ "RUN-PROGRAM", SI_ORDINARY, si_run_program, -1, OBJNULL},
|
||||
|
||||
/* Tag for end of list */
|
||||
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
|
||||
|
||||
|
|
|
|||
48
src/c/tcp.d
48
src/c/tcp.d
|
|
@ -182,42 +182,6 @@ create_server_port(int port)
|
|||
return(conn);
|
||||
}
|
||||
|
||||
/***********************************************************************
|
||||
* Interface from file descriptors to streams
|
||||
**********************************************************************/
|
||||
|
||||
cl_object
|
||||
make_stream(cl_object host, int fd, enum ecl_smmode smm)
|
||||
{
|
||||
cl_object stream;
|
||||
char *mode; /* file open mode */
|
||||
FILE *fp; /* file pointer */
|
||||
|
||||
switch(smm) {
|
||||
case smm_input:
|
||||
mode = "r";
|
||||
break;
|
||||
case smm_output:
|
||||
mode = "w";
|
||||
break;
|
||||
default:
|
||||
FEerror("make_stream: wrong mode", 0);
|
||||
}
|
||||
fp = fdopen(fd, mode);
|
||||
|
||||
stream = cl_alloc_object(t_stream);
|
||||
stream->stream.mode = (short)smm;
|
||||
stream->stream.file = fp;
|
||||
stream->stream.object0 = @'base-char';
|
||||
stream->stream.object1 = host; /* not really used */
|
||||
stream->stream.int0 = stream->stream.int1 = 0;
|
||||
#if !defined(GBC_BOEHM)
|
||||
fp->_IO_buf_base = NULL; /* BASEFF */;
|
||||
setbuf(fp, stream->stream.buffer = cl_alloc_atomic(BUFSIZ));
|
||||
#endif
|
||||
return(stream);
|
||||
}
|
||||
|
||||
/***********************************************************************
|
||||
* Public interface to lisp environment
|
||||
**********************************************************************/
|
||||
|
|
@ -252,8 +216,8 @@ si_open_client_stream(cl_object host, cl_object port)
|
|||
if (fd == 0)
|
||||
@(return Cnil)
|
||||
|
||||
streamIn = make_stream(host, fd, smm_input);
|
||||
streamOut = make_stream(host, fd, smm_output);
|
||||
streamIn = ecl_make_stream_from_fd(host, fd, smm_input);
|
||||
streamOut = ecl_make_stream_from_fd(host, fd, smm_output);
|
||||
|
||||
@(return make_two_way_stream(streamIn, streamOut))
|
||||
}
|
||||
|
|
@ -272,8 +236,8 @@ si_open_server_stream(cl_object port)
|
|||
if (fd == 0)
|
||||
output = Cnil;
|
||||
else {
|
||||
streamIn = make_stream(Cnil, fd, smm_input);
|
||||
streamOut = make_stream(Cnil, fd, smm_output);
|
||||
streamIn = ecl_make_stream_from_fd(Cnil, fd, smm_input);
|
||||
streamOut = ecl_make_stream_from_fd(Cnil, fd, smm_output);
|
||||
output = make_two_way_stream(streamIn, streamOut);
|
||||
}
|
||||
@(return output)
|
||||
|
|
@ -311,8 +275,8 @@ si_open_unix_socket_stream(cl_object path)
|
|||
@(return Cnil)
|
||||
}
|
||||
|
||||
streamIn = make_stream(path, fd, smm_input);
|
||||
streamOut = make_stream(path, fd, smm_output);
|
||||
streamIn = ecl_make_stream_from_fd(path, fd, smm_input);
|
||||
streamOut = ecl_make_stream_from_fd(path, fd, smm_output);
|
||||
|
||||
@(return make_two_way_stream(streamIn, streamOut))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <fcntl.h>
|
||||
#include "ecl.h"
|
||||
#include "internal.h"
|
||||
|
||||
|
|
@ -67,3 +68,93 @@ si_close_pipe(cl_object stream)
|
|||
}
|
||||
@(return)
|
||||
}
|
||||
|
||||
@(defun ext::run-program (command argv &key (input @':stream') (output @':stream')
|
||||
(error @'nil'))
|
||||
cl_object input_pipe_read, input_pipe_write;
|
||||
cl_object output_pipe_read, output_pipe_write;
|
||||
int input_pipe[2], output_pipe[2];
|
||||
int child_stdin, child_stdout, child_stderr;
|
||||
int parent_write = 0, parent_read = 0;
|
||||
int child_pid;
|
||||
cl_object stream_write;
|
||||
cl_object stream_read;
|
||||
@{
|
||||
if (input == @':stream') {
|
||||
int fd[2];
|
||||
pipe(fd);
|
||||
parent_write = fd[1];
|
||||
child_stdin = fd[0];
|
||||
} else if (input == @'t') {
|
||||
child_stdin = dup(0);
|
||||
} else {
|
||||
child_stdin = open("/dev/null", O_RDONLY);
|
||||
}
|
||||
if (output == @':stream') {
|
||||
int fd[2];
|
||||
pipe(fd);
|
||||
parent_read = fd[0];
|
||||
child_stdout = fd[1];
|
||||
} else if (output == @'t') {
|
||||
child_stdout = dup(1);
|
||||
} else {
|
||||
child_stdout = open("/dev/null", O_WRONLY);
|
||||
}
|
||||
if (error == @'t') {
|
||||
child_stderr = dup(2);
|
||||
} else {
|
||||
child_stderr = open("/dev/null", O_WRONLY);
|
||||
}
|
||||
command = cl_string(command);
|
||||
argv = cl_mapcar(2, @'string', argv);
|
||||
argv = CONS(command, nconc(argv, CONS(Cnil, Cnil)));
|
||||
argv = cl_funcall(3, @'coerce', argv, @'vector');
|
||||
child_pid = fork();
|
||||
if (child_pid == 0) {
|
||||
/* Child */
|
||||
int j;
|
||||
void **argv_ptr = (void **)argv->vector.self.t;
|
||||
close(0);
|
||||
dup(child_stdin);
|
||||
if (parent_write) close(parent_write);
|
||||
close(1);
|
||||
dup(child_stdout);
|
||||
if (parent_read) close(parent_read);
|
||||
close(2);
|
||||
dup(child_stderr);
|
||||
for (j = 0; j < argv->vector.fillp; j++) {
|
||||
cl_object arg = argv->vector.self.t[j];
|
||||
if (arg == Cnil) {
|
||||
argv_ptr[j] = NULL;
|
||||
} else {
|
||||
argv_ptr[j] = arg->string.self;
|
||||
}
|
||||
}
|
||||
execv(command->string.self, (const char **)argv_ptr);
|
||||
} else {
|
||||
/* Parent */
|
||||
close(child_stdin);
|
||||
close(child_stdout);
|
||||
close(child_stderr);
|
||||
if (child_pid < 0) {
|
||||
if (parent_write) close(parent_write);
|
||||
if (parent_read) close(parent_read);
|
||||
FEerror("Could not spawn subprocess to run ~S.", 1, command);
|
||||
}
|
||||
if (parent_write) {
|
||||
stream_write = ecl_make_stream_from_fd(command, parent_write,
|
||||
smm_output);
|
||||
} else {
|
||||
stream_write = cl_core.null_stream;
|
||||
}
|
||||
if (parent_read) {
|
||||
stream_read = ecl_make_stream_from_fd(command, parent_read,
|
||||
smm_input);
|
||||
} else {
|
||||
stream_read = cl_core.null_stream;
|
||||
}
|
||||
}
|
||||
@(return ((parent_read || parent_write)?
|
||||
make_two_way_stream(stream_write, stream_read) :
|
||||
Cnil))
|
||||
@)
|
||||
|
|
|
|||
|
|
@ -534,6 +534,7 @@ extern long file_position(cl_object strm);
|
|||
extern long file_position_set(cl_object strm, long disp);
|
||||
extern long file_length(cl_object strm);
|
||||
extern int file_column(cl_object strm);
|
||||
extern cl_object ecl_make_stream_from_fd(cl_object host, int fd, enum ecl_smmode smm);
|
||||
|
||||
|
||||
/* format.c */
|
||||
|
|
@ -1314,7 +1315,6 @@ extern cl_object si_open_client_stream(cl_object host, cl_object port);
|
|||
extern cl_object si_open_server_stream(cl_object port);
|
||||
extern cl_object si_open_unix_socket_stream(cl_object path);
|
||||
extern cl_object si_lookup_host_entry(cl_object host_or_address);
|
||||
extern cl_object make_stream(cl_object host, int fd, enum ecl_smmode smm);
|
||||
#endif
|
||||
|
||||
|
||||
|
|
@ -1430,6 +1430,7 @@ extern cl_object si_check_pending_interrupts(void);
|
|||
extern cl_object si_system(cl_object cmd);
|
||||
extern cl_object si_open_pipe(cl_object cmd);
|
||||
extern cl_object si_close_pipe(cl_object stream);
|
||||
extern cl_object si_run_program _ARGS((int narg, cl_object command, cl_object args, ...));
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue