- EXT:RUN-PROGRAM now accepts a keyword argument, :ENVIRON, which is a
list of strings configuring the environment of the child process.
+ - EXT:RUN-PROGRAM returns as second value an EXT:EXTERNAL-PROCESS structure,
+ which supports the queries EXT:EXTERNAL-PROCESS-{PID,INPUT,OUTPUT,STATUS},
+ following CCL's conventions.
+
+ - New function EXT:EXTERNAL-PROCESS-WAIT to wait indefinitely or simply query
+ the status of a process.
+
;;; Local Variables: ***
;;; mode:text ***
;;; fill-column:79 ***
#endif
#ifdef ECL_SEMAPHORES
case t_semaphore: {
+ ecl_disable_interrupts_env(the_env);
mp_semaphore_close(o);
+ ecl_enable_interrupts_env(the_env);
break;
}
#endif
#ifdef ECL_THREADS
case t_symbol: {
cl_object cons = ecl_list1(MAKE_FIXNUM(o->symbol.binding));
- ecl_disable_interrupts();
+ ecl_disable_interrupts_env(the_env);
THREAD_OP_LOCK();
ECL_CONS_CDR(cons) = cl_core.reused_indices;
cl_core.reused_indices = cons;
THREAD_OP_UNLOCK();
- ecl_enable_interrupts();
+ ecl_enable_interrupts_env(the_env);
}
#endif
default:;
{KEY_ "ENVIRON", KEYWORD, NULL, -1, OBJNULL},
+{EXT_ "MAKE-EXTERNAL-PROCESS", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "EXTERNAL-PROCESS", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "EXTERNAL-PROCESS-PID", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "EXTERNAL-PROCESS-INPUT", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "EXTERNAL-PROCESS-OUTPUT", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "EXTERNAL-PROCESS-STATUS", EXT_ORDINARY, NULL, -1, OBJNULL},
+
+{KEY_ "RUNNING", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "EXITED", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "SIGNALED", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "STOPPED", KEYWORD, NULL, -1, OBJNULL},
+
+{EXT_ "EXTERNAL-PROCESS-WAIT", EXT_ORDINARY, si_external_process_wait, -1, OBJNULL},
+
+#if defined(_MSC_VER) || defined(mingw32)
+{SI_ "CLOSE-WINDOWS-HANDLE", SI_ORDINARY, si_close_windows_handle, 1, OBJNULL},
+#endif
+
/* Tag for end of list */
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
{KEY_ "ENVIRON",NULL},
+{EXT_ "MAKE-EXTERNAL-PROCESS",NULL},
+{EXT_ "EXTERNAL-PROCESS",NULL},
+{EXT_ "EXTERNAL-PROCESS-PID",NULL},
+{EXT_ "EXTERNAL-PROCESS-INPUT",NULL},
+{EXT_ "EXTERNAL-PROCESS-OUTPUT",NULL},
+{EXT_ "EXTERNAL-PROCESS-STATUS",NULL},
+
+{KEY_ "RUNNING",NULL},
+{KEY_ "EXITED",NULL},
+{KEY_ "SIGNALED",NULL},
+{KEY_ "STOPPED",NULL},
+
+{EXT_ "EXTERNAL-PROCESS-WAIT","si_external_process_wait"},
+
+#if defined(_MSC_VER) || defined(mingw32)
+{SI_ "CLOSE-WINDOWS-HANDLE","si_close_windows_handle"},
+#endif
+
/* Tag for end of list */
{NULL,NULL}};
}
buffer->base_string.self[i++] = 0;
environ[j] = 0;
- if (environp) environp = environ;
+ if (environp) *environp = environ;
return buffer;
}
+static cl_object
+make_external_process(cl_object pid, cl_object input, cl_object output)
+{
+ return cl_funcall(4, @'ext::make-external-process', pid, input, output);
+}
+
+#if defined(_MSC_VER) || defined(mingw32)
+cl_object
+si_close_windows_handle(cl_object h)
+{
+ if (type_of(h) == t_foreign) {
+ HANDLE *ph = (HANDLE*)h->foreign.data;
+ if (ph) CloseHandle(*ph);
+ }
+}
+
+static cl_object
+make_windows_handle(HANDLE h)
+{
+ cl_object h = ecl_allocate_foreign_data(@':pointer', sizeof(HANDLE*));
+ HANDLE *ph = (HANDLE*)h->foreign.data;
+ *ph = h;
+ si_set_finalizer(h, @'si::close-windows-handle');
+ return h;
+}
+#endif
+
+@(defun ext::external-process-wait (process_or_pid &optional (wait Cnil))
+ cl_object status, code;
+@
+{
+ if (!FIXNUMP(process_or_pid)) {
+ cl_object pid = cl_funcall(2, @'ext::external-process-pid',
+ process_or_pid);
+ if (Null(pid)) {
+ /* Process already exited */
+ return cl_funcall(2, @'ext::external-process-status',
+ process_or_pid);
+ }
+ status = si_external_process_wait(2, pid, wait);
+ code = VALUES(1);
+ ecl_structure_set(process_or_pid, @'ext::external-process',
+ 0, Cnil);
+ ecl_structure_set(process_or_pid, @'ext::external-process',
+ 3, status);
+ ecl_structure_set(process_or_pid, @'ext::external-process',
+ 4, code);
+ } else {
+ cl_object exit_status = Cnil;
+#if defined(_MSC_VER) || defined(mingw32)
+ HANDLE *hProcess = ecl_foreign_data_pointer_safe(process_or_pid);
+ DWORD exitcode;
+ int ok;
+ WaitForSingleObject(*hProcess, Null(wait)? 0 : INFINITE);
+ ecl_disable_interrupts_env(the_env);
+ ok = GetExitCodeProcess(*hProcess, &exitcode);
+ if (!ok) {
+ status = @':error';
+ } else if (exitcode == STILL_ACTIVE) {
+ status = @':runnning';
+ } else {
+ status = @':exited';
+ code = MAKE_FIXNUM(exitcode);
+ process_or_pid->foreign.data = NULL;
+ CloseHandle(*hProcess);
+ }
+ ecl_enable_interrupts(the_env);
+#else
+ cl_index pid = fix(process_or_pid);
+ int code_int;
+ int error = waitpid(pid, &code_int, Null(wait)? WNOHANG : 0);
+ if (error < 0) {
+ status = @':error';
+ } else if (WIFEXITED(code_int)) {
+ status = @':exited';
+ code = MAKE_FIXNUM(WEXITSTATUS(code_int));
+ } else if (WIFSIGNALED(code_int)) {
+ status = @':signaled';
+ code = MAKE_FIXNUM(WTERMSIG(code_int));
+ } else if (WIFSTOPPED(code_int)) {
+ status = @':stopped';
+ code = MAKE_FIXNUM(WSTOPSIG(code_int));
+ } else {
+ status = @':running';
+ code = Cnil;
+ }
+#endif
+ }
+ @(return status code)
+}
+@)
+
@(defun ext::run-program (command argv &key (input @':stream') (output @':stream')
(error @'t') (wait @'t') (environ Cnil))
int parent_write = 0, parent_read = 0;
int child_pid;
+ cl_object pid, process;
cl_object stream_write;
cl_object stream_read;
cl_object exit_status = Cnil;
+ cl_object external_process;
@
command = si_copy_to_simple_base_string(command);
argv = cl_mapcar(2, @'si::copy-to-simple-base-string', argv);
if (child_stdout) CloseHandle(child_stdout);
if (child_stderr) CloseHandle(child_stderr);
if (ok) {
- DWORD exitcode;
CloseHandle(pr_info.hThread);
- child_pid = pr_info.dwProcessId;
- if (wait != Cnil) {
- WaitForSingleObject(pr_info.hProcess, INFINITE);
- if (GetExitCodeProcess(pr_info.hProcess, &exitcode) &&
- STILL_ACTIVE != exitcode) {
- exit_status = MAKE_FIXNUM(exitcode);
- }
- }
- CloseHandle(pr_info.hProcess);
+ pid = make_windows_handle(pr_info.hProcess);
} else {
const char *message;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
0, GetLastError(), 0, (void*)&message, 0, NULL);
printf("%s\n", message);
LocalFree(message);
- child_pid = -1;
+ pid = Cnil;
}
}
#else /* mingw */
close(child_stdin);
close(child_stdout);
close(child_stderr);
- if (child_pid > 0 && wait != Cnil) {
- int status;
- waitpid(child_pid, &status, 0);
- exit_status = MAKE_FIXNUM(WEXITSTATUS(status));
- }
+ if (child_pid < 0) {
+ pid = Cnil;
+ } else {
+ pid = MAKE_FIXNUM(child_pid);
+ }
}
#endif /* mingw */
- if (child_pid < 0) {
+ if (Null(pid)) {
if (parent_write) close(parent_write);
if (parent_read) close(parent_read);
parent_write = 0;
parent_read = 0;
stream_read = cl_core.null_stream;
}
+ process = make_external_process(pid, stream_write, stream_read);
+ if (!Null(wait)) {
+ exit_status = si_external_process_wait(2, process, Ct);
+ exit_status = VALUES(1);
+ }
@(return ((parent_read || parent_write)?
cl_make_two_way_stream(stream_read, stream_write) :
Cnil)
- exit_status)
+ exit_status
+ process)
@)
"src:lsp;describe.lsp" ; Depends on conditions.lsp
"src:clos;inspect.lsp" ; Depends on describe.lsp
"src:lsp;top.lsp" ; Depends on conditions.lsp
+ "src:lsp;process.lsp" ; Depends on defclass
))
(mapc #'(lambda (x)
extern ECL_API cl_object si_system(cl_object cmd);
extern ECL_API cl_object si_make_pipe();
extern ECL_API cl_object si_run_program _ARGS((cl_narg narg, cl_object command, cl_object args, ...));
+extern ECL_API cl_object si_external_process_wait _ARGS((cl_narg narg, cl_object h, ...));
+extern ECL_API cl_object si_close_windows_handle(cl_object h);
/* unicode -- no particular file, but we group these changes here */
--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SYSTEM -*-
+;;;;
+;;;; PROCESS.LSP -- External processes
+
+;;;; Copyright (c) 2003, Juan Jose Garcia-Ripoll
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Library General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2 of the License, or (at your option) any later version.
+;;;;
+;;;; See file '../Copyright' for full details.
+
+(in-package "EXT")
+
+(defstruct (external-process (:constructor make-external-process
+ (pid input output)))
+ pid
+ input
+ output
+ (%status :running)
+ (%code nil))
+
+(defun external-process-status (external-process)
+ (let ((status (external-process-%status external-process)))
+ (when (eq status :running)
+ (ext:external-process-wait external-process nil)
+ (values status (external-process-%code external-process)))))
Repositories / ecl.git / commitdiff