Mercurial > hg > xemacs-beta
diff src/process.c @ 263:727739f917cb r20-5b30
Import from CVS: tag r20-5b30
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 10:24:41 +0200 |
| parents | 11cf20601dec |
| children | 966663fcf606 |
line wrap: on
line diff
--- a/src/process.c Mon Aug 13 10:23:52 2007 +0200 +++ b/src/process.c Mon Aug 13 10:24:41 2007 +0200 @@ -21,11 +21,13 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Synched up with: Mule 2.0, FSF 19.30. */ - /* This file has been Mule-ized except for `start-process-internal', `open-network-stream-internal' and `open-multicast-group-internal'. */ +/* This file has been split into process.c and process-unix.c by + Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not + the original author(s) */ + #include <config.h> #if !defined (NO_SUBPROCESSES) @@ -38,25 +40,30 @@ #include "commands.h" #include "events.h" #include "frame.h" +#include "hash.h" #include "insdel.h" #include "lstream.h" #include "opaque.h" #include "process.h" +#include "procimpl.h" #include "sysdep.h" #include "window.h" #ifdef FILE_CODING #include "file-coding.h" #endif -#include <setjmp.h> #include "sysfile.h" #include "sysproc.h" #include "systime.h" #include "syssignal.h" /* Always include before systty.h */ - #include "systty.h" #include "syswait.h" +Lisp_Object Qprocessp; + +/* Process methods */ +struct process_methods the_process_methods; + /* a process object is a network connection when its pid field a cons (name of name of port we are connected to . foreign host name) */ @@ -64,6 +71,8 @@ Lisp_Object Qrun, Qstop; /* Qexit from eval.c, Qsignal from data.c. */ /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ Lisp_Object Qopen, Qclosed; +/* Protocol families */ +Lisp_Object Qtcpip; #ifdef HAVE_MULTICAST Lisp_Object Qmulticast; /* Will be used for occasional warnings */ @@ -71,20 +80,16 @@ /* t means use pty, nil means use a pipe, maybe other values to come. */ -static Lisp_Object Vprocess_connection_type; +Lisp_Object Vprocess_connection_type; #ifdef PROCESS_IO_BLOCKING /* List of port numbers or port names to set a blocking I/O mode. Nil means set a non-blocking I/O mode [default]. */ -static Lisp_Object network_stream_blocking_port_list; +Lisp_Object network_stream_blocking_port_list; #endif /* PROCESS_IO_BLOCKING */ -/* FSFmacs says: - - These next two vars are non-static since sysdep.c uses them in the - emulation of `select'. */ /* Number of events of change of status of a process. */ -static volatile int process_tick; +volatile int process_tick; /* Number of events for which the user or sentinel has been notified. */ static int update_tick; @@ -92,114 +97,14 @@ /* Nonzero means delete a process right away if it exits. */ int delete_exited_processes; -/* Indexed by descriptor, gives the process (if any) for that descriptor */ -Lisp_Object descriptor_to_process[MAXDESC]; +/* Hashtable which maps USIDs as returned by create_stream_pair_cb to + process objects. Processes are not GC-protected through this! */ +c_hashtable usid_to_process; /* List of process objects. */ Lisp_Object Vprocess_list; -Lisp_Object Qprocessp; - -/* Buffered-ahead input char from process, indexed by channel. - -1 means empty (no char is buffered). - Used on sys V where the only way to tell if there is any - output from the process is to read at least one char. - Always -1 on systems that support FIONREAD. */ - -#if 0 /* FSFmacs */ -/* FSFmacs says: - Don't make static; need to access externally. */ -static int proc_buffered_char[MAXDESC]; -#endif - -#ifdef HAVE_PTYS -/* The file name of the pty opened by allocate_pty. */ - -static char pty_name[24]; -#endif - -/************************************************************************/ -/* the process Lisp object */ -/************************************************************************/ - -/* - * Structure records pertinent information about open channels. - * There is one channel associated with each process. - */ - -struct Lisp_Process -{ - struct lcrecord_header header; - /* Name of this process */ - Lisp_Object name; - /* List of command arguments that this process was run with */ - Lisp_Object command; - /* (funcall FILTER PROC STRING) (if FILTER is non-nil) - to dispose of a bunch of chars from the process all at once */ - Lisp_Object filter; - /* (funcall SENTINEL PROCESS) when process state changes */ - Lisp_Object sentinel; - /* Buffer that output is going to */ - Lisp_Object buffer; - /* Marker set to end of last buffer-inserted output from this process */ - Lisp_Object mark; - /* Lisp_Int of subprocess' PID, or a cons of - service/host if this is really a network connection */ - Lisp_Object pid; - /* Non-0 if this is really a ToolTalk channel. */ - int connected_via_filedesc_p; -#if 0 /* FSFmacs */ - /* Perhaps it's cleaner this way, but FSFmacs - provides no way of retrieving this value, so I'll - leave this info with PID. */ - /* Non-nil if this is really a child process */ - Lisp_Object childp; -#endif - - /* Symbol indicating status of process. - This may be a symbol: run, stop, exit, signal */ - Lisp_Object status_symbol; - - - /* Exit code if process has terminated, - signal which stopped/interrupted process - or 0 if process is running */ - int exit_code; - /* Number of this process */ - /* Non-false if process has exited and "dumped core" on its way down */ - char core_dumped; - /* Descriptor by which we read from this process. -1 for dead process */ - int infd; - /* Descriptor by which we write to this process. -1 for dead process */ - int outfd; - /* Descriptor for the tty which this process is using. - -1 if we didn't record it (on some systems, there's no need). */ - int subtty; - /* Name of subprocess terminal. */ - Lisp_Object tty_name; - /* Non-false if communicating through a pty. */ - char pty_flag; - /* This next field is only actually used #ifdef ENERGIZE */ - /* if this flag is not NIL, then filter will do the read on the - channel, rather than having a call to make_string. - This only works if the filter is a subr. */ - char filter_does_read; - /* Non-nil means kill silently if Emacs is exited. */ - char kill_without_query; - char selected; - /* Event-count of last event in which this process changed status. */ - volatile int tick; - /* Event-count of last such event reported. */ - int update_tick; - /* streams used in input and output */ - Lisp_Object instream; - Lisp_Object outstream; - /* The actual filedesc stream used for output; may be different - than OUTSTREAM under Mule */ - Lisp_Object filedesc_stream; -}; - static Lisp_Object mark_process (Lisp_Object, void (*) (Lisp_Object)); static void print_process (Lisp_Object, Lisp_Object, int); static void finalize_process (void *, int); @@ -211,6 +116,7 @@ mark_process (Lisp_Object obj, void (*markobj) (Lisp_Object)) { struct Lisp_Process *proc = XPROCESS (obj); + MAYBE_PROCMETH (mark_process_data, (proc, markobj)); ((markobj) (proc->name)); ((markobj) (proc->command)); ((markobj) (proc->filter)); @@ -218,10 +124,12 @@ ((markobj) (proc->buffer)); ((markobj) (proc->mark)); ((markobj) (proc->pid)); - ((markobj) (proc->tty_name)); - ((markobj) (proc->instream)); - ((markobj) (proc->outstream)); - ((markobj) (proc->filedesc_stream)); + ((markobj) (proc->pipe_instream)); + ((markobj) (proc->pipe_outstream)); +#ifdef FILE_CODING + ((markobj) (proc->coding_instream)); + ((markobj) (proc->coding_outstream)); +#endif return proc->status_symbol; } @@ -248,6 +156,7 @@ print_internal (proc->pid, printcharfun, 1); write_c_string (" state:", printcharfun); print_internal (proc->status_symbol, printcharfun, 1); + MAYBE_PROCMETH (print_process_data, (proc, printcharfun)); write_c_string (">", printcharfun); } } @@ -259,15 +168,22 @@ static void finalize_process (void *header, int for_disksave) { - if (for_disksave) return; /* hmm, what would this do anyway? */ /* #### this probably needs to be tied into the tty event loop */ /* #### when there is one */ + struct Lisp_Process *p = (struct Lisp_Process *) header; #ifdef HAVE_WINDOW_SYSTEM - { - struct Lisp_Process *p = (struct Lisp_Process *) header; - debug_process_finalization (p); - } + if (!for_disksave) + { + debug_process_finalization (p); + } #endif /* HAVE_WINDOW_SYSTEM */ + + if (p->process_data) + { + MAYBE_PROCMETH (finalize_process_data, (p, for_disksave)); + if (!for_disksave) + xfree (p->process_data); + } } @@ -275,78 +191,35 @@ /* basic process accessors */ /************************************************************************/ -static SIGTYPE -close_safely_handler (int signo) -{ - EMACS_REESTABLISH_SIGNAL (signo, close_safely_handler); - SIGRETURN; -} - -static void -close_safely (int fd) -{ - stop_interrupts (); - signal (SIGALRM, close_safely_handler); - alarm (1); - close (fd); - alarm (0); - start_interrupts (); -} - -static void -close_descriptor_pair (int in, int out) +/* Under FILE_CODING, this function returns low-level streams, connected + directrly to the child process, rather than en/decoding FILE_CODING + streams */ +void +get_process_streams (struct Lisp_Process *p, + Lisp_Object *instr, Lisp_Object *outstr) { - if (in >= 0) - close (in); - if (out != in && out >= 0) - close (out); -} - -/* Close all descriptors currently in use for communication - with subprocess. This is used in a newly-forked subprocess - to get rid of irrelevant descriptors. */ - -void -close_process_descs (void) -{ -#ifndef WINDOWSNT - int i; - for (i = 0; i < MAXDESC; i++) - { - Lisp_Object process; - process = descriptor_to_process[i]; - if (!NILP (process)) - { - close_descriptor_pair (XPROCESS (process)->infd, - XPROCESS (process)->outfd); - } - } -#endif -} - -void -get_process_file_descriptors (struct Lisp_Process *p, int *infd, - int *outfd) -{ - if (! p) abort (); - /* the cast of MAXDESC is needed for some versions of Linux */ - assert (p->infd >= -1 && p->infd < ((int) (MAXDESC))); - assert (p->outfd >= -1 && p->outfd < ((int) (MAXDESC))); - *infd = p->infd; - *outfd = p->outfd; + assert (p); + assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream)); + assert (NILP (p->pipe_outstream) || LSTREAMP(p->pipe_outstream)); + *instr = p->pipe_instream; + *outstr = p->pipe_outstream; } struct Lisp_Process * -get_process_from_input_descriptor (int infd) +get_process_from_usid (USID usid) { - Lisp_Object proc; + CONST void *vval; + + assert (usid != USID_ERROR && usid != USID_DONTHASH); - if ((infd < 0) || (infd >= ((int) (MAXDESC)))) abort (); - proc = descriptor_to_process[infd]; - if (NILP (proc)) + if (gethash ((CONST void*)usid, usid_to_process, &vval)) + { + Lisp_Object proc; + CVOID_TO_LISP (proc, vval); + return XPROCESS (proc); + } + else return 0; - else - return XPROCESS (proc); } int @@ -361,6 +234,12 @@ p->selected = !!selected_p; } +int +connected_via_filedesc_p (struct Lisp_Process *p) +{ + return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); +} + #ifdef HAVE_SOCKETS int network_connection_p (Lisp_Object process) @@ -369,12 +248,6 @@ } #endif -int -connected_via_filedesc_p (struct Lisp_Process *p) -{ - return p->connected_via_filedesc_p; -} - DEFUN ("processp", Fprocessp, 1, 1, 0, /* Return t if OBJECT is a process. */ @@ -483,7 +356,9 @@ } else { - /* fsf: CHECK_PROCESS (obj, 0); */ + /* #### This was commented out. Although, simple + (kill-process 7 "qqq") resulted in a falat error. - kkm */ + CHECK_PROCESS (obj); proc = obj; } return proc; @@ -535,7 +410,7 @@ /* creating a process */ /************************************************************************/ -static Lisp_Object +Lisp_Object make_process_internal (Lisp_Object name) { Lisp_Object val, name1; @@ -564,21 +439,22 @@ p->mark = Fmake_marker (); p->pid = Qnil; p->status_symbol = Qrun; - p->connected_via_filedesc_p = 0; p->exit_code = 0; p->core_dumped = 0; - p->infd = -1; - p->outfd = -1; - p->subtty = -1; - p->tty_name = Qnil; - p->pty_flag = 0; p->filter_does_read = 0; p->kill_without_query = 0; p->selected = 0; p->tick = 0; p->update_tick = 0; - p->instream = Qnil; - p->outstream = Qnil; + p->pipe_instream = Qnil; + p->pipe_outstream = Qnil; +#ifdef FILE_CODING + p->coding_instream = Qnil; + p->coding_outstream = Qnil; +#endif + + p->process_data = 0; + MAYBE_PROCMETH (alloc_process_data, (p)); XSETPROCESS (val, p); @@ -586,506 +462,55 @@ return val; } -#ifdef HAVE_PTYS - -/* Open an available pty, returning a file descriptor. - Return -1 on failure. - The file name of the terminal corresponding to the pty - is left in the variable pty_name. */ - -static int -allocate_pty (void) +void +init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) { - struct stat stb; - int c, i; - int fd; - - /* Some systems name their pseudoterminals so that there are gaps in - the usual sequence - for example, on HP9000/S700 systems, there - are no pseudoterminals with names ending in 'f'. So we wait for - three failures in a row before deciding that we've reached the - end of the ptys. */ - int failed_count = 0; - -#ifdef PTY_ITERATION - PTY_ITERATION -#else - for (c = FIRST_PTY_LETTER; c <= 'z'; c++) - for (i = 0; i < 16; i++) -#endif - { -#ifdef PTY_NAME_SPRINTF - PTY_NAME_SPRINTF -#else - sprintf (pty_name, "/dev/pty%c%x", c, i); -#endif /* no PTY_NAME_SPRINTF */ - -#ifdef PTY_OPEN - PTY_OPEN; -#else /* no PTY_OPEN */ -#ifdef IRIS - /* Unusual IRIS code */ - *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY | OPEN_BINARY, 0); - if (fd < 0) - return -1; - if (fstat (fd, &stb) < 0) - return -1; -#else /* not IRIS */ - if (stat (pty_name, &stb) < 0) - { - failed_count++; - if (failed_count >= 3) - return -1; - } - else - failed_count = 0; -#ifdef O_NONBLOCK - fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); -#else - fd = open (pty_name, O_RDWR | O_NDELAY | OPEN_BINARY, 0); -#endif -#endif /* not IRIS */ -#endif /* no PTY_OPEN */ - - if (fd >= 0) - { - /* check to make certain that both sides are available - this avoids a nasty yet stupid bug in rlogins */ -#ifdef PTY_TTY_NAME_SPRINTF - PTY_TTY_NAME_SPRINTF -#else - sprintf (pty_name, "/dev/tty%c%x", c, i); -#endif /* no PTY_TTY_NAME_SPRINTF */ -#ifndef UNIPLUS - if (access (pty_name, 6) != 0) - { - close (fd); -#if !defined(IRIS) && !defined(__sgi) - continue; -#else - return -1; -#endif /* IRIS */ - } -#endif /* not UNIPLUS */ - setup_pty (fd); - return fd; - } - } - return -1; -} -#endif /* HAVE_PTYS */ - -static int -create_bidirectional_pipe (int *inchannel, int *outchannel, - volatile int *forkin, volatile int *forkout) -{ - int sv[2]; + USID usid = event_stream_create_stream_pair (in, out, + &p->pipe_instream, &p->pipe_outstream, + flags); -#ifdef SKTPAIR - if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0) - return -1; - *outchannel = *inchannel = sv[0]; - *forkout = *forkin = sv[1]; -#else /* not SKTPAIR */ - int temp; - temp = pipe (sv); - if (temp < 0) return -1; - *inchannel = sv[0]; - *forkout = sv[1]; - temp = pipe (sv); - if (temp < 0) return -1; - *outchannel = sv[1]; - *forkin = sv[0]; -#endif /* not SKTPAIR */ - return 0; -} - - -static Bufbyte -get_eof_char (struct Lisp_Process *p) -{ - /* Figure out the eof character for the outfd of the given process. - * The following code is similar to that in process_send_signal, and - * should probably be merged with that code somehow. */ - - CONST Bufbyte ctrl_d = (Bufbyte) '\004'; - - if (!isatty (p->outfd)) - return ctrl_d; -#ifdef HAVE_TERMIOS - { - struct termios t; - tcgetattr (p->outfd, &t); -#if 0 - /* What is the following line designed to do??? -mrb */ - if (strlen ((CONST char *) t.c_cc) < (unsigned int) (VEOF + 1)) - return ctrl_d; - else - return (Bufbyte) t.c_cc[VEOF]; -#endif - return t.c_cc[VEOF] == CDISABLE ? ctrl_d : (Bufbyte) t.c_cc[VEOF]; - } -#else /* ! HAVE_TERMIOS */ - /* On Berkeley descendants, the following IOCTL's retrieve the - current control characters. */ -#if defined (TIOCGETC) - { - struct tchars c; - ioctl (p->outfd, TIOCGETC, &c); - return (Bufbyte) c.t_eofc; - } -#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ - /* On SYSV descendants, the TCGETA ioctl retrieves the current control - characters. */ -#ifdef TCGETA - { - struct termio t; - ioctl (p->outfd, TCGETA, &t); - if (strlen ((CONST char *) t.c_cc) < (unsigned int) (VINTR + 1)) - return ctrl_d; - else - return (Bufbyte) t.c_cc[VINTR]; - } -#else /* ! defined (TCGETA) */ - /* Rather than complain, we'll just guess ^D, which is what - * earlier emacsen always used. */ - return ctrl_d; -#endif /* ! defined (TCGETA) */ -#endif /* ! defined (TIOCGETC) */ -#endif /* ! defined (HAVE_TERMIOS) */ -} - -static int -get_pty_max_bytes (struct Lisp_Process *p) -{ - int pty_max_bytes; - -#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) - pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON); - if (pty_max_bytes < 0) - pty_max_bytes = 250; -#else - pty_max_bytes = 250; -#endif - /* Deduct one, to leave space for the eof. */ - pty_max_bytes--; - - return pty_max_bytes; -} - -static void -init_process_fds (struct Lisp_Process *p, int in, int out) -{ - p->infd = in; - p->outfd = out; - p->instream = make_filedesc_input_stream (in, 0, -1, 0); - p->outstream = make_filedesc_output_stream (out, 0, -1, - LSTR_BLOCKED_OK - | (p->pty_flag ? - LSTR_PTY_FLUSHING : 0)); - p->filedesc_stream = p->outstream; - if (p->pty_flag) + if (usid == USID_ERROR) + report_file_error ("Setting up communication with subprocess", Qnil); + + if (usid != USID_DONTHASH) { - Bufbyte eof_char = get_eof_char (p); - int pty_max_bytes = get_pty_max_bytes (p); - filedesc_stream_set_pty_flushing (XLSTREAM (p->outstream), - pty_max_bytes, eof_char); + Lisp_Object proc = Qnil; + XSETPROCESS (proc, p); + puthash ((CONST void*)usid, LISP_TO_VOID (proc), usid_to_process); } -#ifdef FILE_CODING + MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags)); - p->instream = make_decoding_input_stream - (XLSTREAM (p->instream), +#ifdef FILE_CODING + p->coding_instream = make_decoding_input_stream + (XLSTREAM (p->pipe_instream), Fget_coding_system (Vcoding_system_for_read)); - Lstream_set_character_mode (XLSTREAM (p->instream)); - p->outstream = make_encoding_output_stream - (XLSTREAM (p->outstream), + Lstream_set_character_mode (XLSTREAM (p->coding_instream)); + p->coding_outstream = make_encoding_output_stream + (XLSTREAM (p->pipe_outstream), Fget_coding_system (Vcoding_system_for_write)); /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!#### What's going on here? */ -#endif +#endif /* FILE_CODING */ } static void create_process (Lisp_Object process, char **new_argv, CONST char *current_dir) { - /* This function rewritten by wing@666.com. */ - - int pid, inchannel, outchannel; - /* Use volatile to protect variables from being clobbered by longjmp. */ - volatile int forkin, forkout; - volatile int pty_flag = 0; - char **env; struct Lisp_Process *p = XPROCESS (process); - - env = environ; - - inchannel = outchannel = forkin = forkout = -1; - -#ifdef HAVE_PTYS - if (!NILP (Vprocess_connection_type)) - { - /* find a new pty, open the master side, return the opened - file handle, and store the name of the corresponding slave - side in global variable pty_name. */ - outchannel = inchannel = allocate_pty (); - } + int pid; - if (inchannel >= 0) - { - /* You're "supposed" to now open the slave in the child. - On some systems, we can open it here; this allows for - better error checking. */ -#if !defined(USG) - /* On USG systems it does not work to open the pty's tty here - and then close and reopen it in the child. */ -#ifdef O_NOCTTY - /* Don't let this terminal become our controlling terminal - (in case we don't have one). */ - forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY | OPEN_BINARY, 0); -#else - forkout = forkin = open (pty_name, O_RDWR | OPEN_BINARY, 0); -#endif - if (forkin < 0) - goto io_failure; -#endif /* not USG */ - p->pty_flag = pty_flag = 1; - } - else -#endif /* HAVE_PTYS */ - if (create_bidirectional_pipe (&inchannel, &outchannel, - &forkin, &forkout) < 0) - goto io_failure; - -#if 0 - /* Replaced by close_process_descs */ - set_exclusive_use (inchannel); - set_exclusive_use (outchannel); -#endif - - set_descriptor_non_blocking (inchannel); - - /* Record this as an active process, with its channels. - As a result, child_setup will close Emacs's side of the pipes. */ - descriptor_to_process[inchannel] = process; - init_process_fds (p, inchannel, outchannel); - /* Record the tty descriptor used in the subprocess. */ - p->subtty = forkin; + /* *_create_process may change status_symbol, if the process + is a kind of "fire-and-forget" (no I/O, unwaitable) */ p->status_symbol = Qrun; p->exit_code = 0; - { -#if !defined(__CYGWIN32__) - /* child_setup must clobber environ on systems with true vfork. - Protect it from permanent change. */ - char **save_environ = environ; -#endif - -#ifdef EMACS_BTL - /* when performance monitoring is on, turn it off before the vfork(), - as the child has no handler for the signal -- when back in the - parent process, turn it back on if it was really on when you "turned - it off" */ - int logging_on = cadillac_stop_logging (); /* #### rename me */ -#endif - -#ifndef WINDOWSNT - pid = fork (); - if (pid == 0) -#endif /* not WINDOWSNT */ - { - /**** Now we're in the child process ****/ - int xforkin = forkin; - int xforkout = forkout; - - if (!pty_flag) - EMACS_SEPARATE_PROCESS_GROUP (); -#ifdef HAVE_PTYS - else - { - /* Disconnect the current controlling terminal, pursuant to - making the pty be the controlling terminal of the process. - Also put us in our own process group. */ - - disconnect_controlling_terminal (); - - /* Open the pty connection and make the pty's terminal - our controlling terminal. - - On systems with TIOCSCTTY, we just use it to set - the controlling terminal. On other systems, the - first TTY we open becomes the controlling terminal. - So, we end up with four possibilities: - - (1) on USG and TIOCSCTTY systems, we open the pty - and use TIOCSCTTY. - (2) on other USG systems, we just open the pty. - (3) on non-USG systems with TIOCSCTTY, we - just use TIOCSCTTY. (On non-USG systems, we - already opened the pty in the parent process.) - (4) on non-USG systems without TIOCSCTTY, we - close the pty and reopen it. - - This would be cleaner if we didn't open the pty - in the parent process, but doing it that way - makes it possible to trap error conditions. - It's harder to convey an error from the child - process, and I don't feel like messing with - this now. */ - - /* There was some weirdo, probably wrong, - conditionalization on RTU and UNIPLUS here. - I deleted it. So sue me. */ - - /* SunOS has TIOCSCTTY but the close/open method - also works. */ - -# if defined (USG) || !defined (TIOCSCTTY) - /* Now close the pty (if we had it open) and reopen it. - This makes the pty the controlling terminal of the - subprocess. */ - /* I wonder if close (open (pty_name, ...)) would work? */ - if (xforkin >= 0) - close (xforkin); - xforkout = xforkin = open (pty_name, O_RDWR | OPEN_BINARY, 0); - if (xforkin < 0) - { - write (1, "Couldn't open the pty terminal ", 31); - write (1, pty_name, strlen (pty_name)); - write (1, "\n", 1); - _exit (1); - } -# endif /* USG or not TIOCSCTTY */ - - /* Miscellaneous setup required for some systems. - Must be done before using tc* functions on xforkin. - This guarantees that isatty(xforkin) is true. */ - -# ifdef SETUP_SLAVE_PTY - SETUP_SLAVE_PTY; -# endif /* SETUP_SLAVE_PTY */ - -# ifdef TIOCSCTTY - /* We ignore the return value - because faith@cs.unc.edu says that is necessary on Linux. */ - assert (isatty (xforkin)); - ioctl (xforkin, TIOCSCTTY, 0); -# endif /* TIOCSCTTY */ - - /* Change the line discipline. */ - -# if defined (HAVE_TERMIOS) && defined (LDISC1) - { - struct termios t; - assert (isatty (xforkin)); - tcgetattr (xforkin, &t); - t.c_lflag = LDISC1; - if (tcsetattr (xforkin, TCSANOW, &t) < 0) - perror ("create_process/tcsetattr LDISC1 failed\n"); - } -# elif defined (NTTYDISC) && defined (TIOCSETD) - { - /* Use new line discipline. TIOCSETD is accepted and - ignored on Sys5.4 systems with ttcompat. */ - int ldisc = NTTYDISC; - assert (isatty (xforkin)); - ioctl (xforkin, TIOCSETD, &ldisc); - } -# endif /* TIOCSETD & NTTYDISC */ - - /* Make our process group be the foreground group - of our new controlling terminal. */ - - { - int piddly = EMACS_GET_PROCESS_GROUP (); - EMACS_SET_TTY_PROCESS_GROUP (xforkin, &piddly); - } - -# ifdef AIX - /* On AIX, we've disabled SIGHUP above once we start a - child on a pty. Now reenable it in the child, so it - will die when we want it to. */ - signal (SIGHUP, SIG_DFL); -# endif /* AIX */ - } -#endif /* HAVE_PTYS */ - - signal (SIGINT, SIG_DFL); - signal (SIGQUIT, SIG_DFL); - -#if !defined(MSDOS) && !defined(WINDOWSNT) - if (pty_flag) - { - /* Set up the terminal characteristics of the pty. */ - child_setup_tty (xforkout); - } - -#ifdef WINDOWSNT - pid = child_setup (xforkin, xforkout, xforkout, - new_argv, current_dir); -#else /* not WINDOWSNT */ - child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); -#endif /* not WINDOWSNT */ -#endif /* not MSDOS */ - } -#ifdef EMACS_BTL - else if (logging_on) - cadillac_start_logging (); /* #### rename me */ -#endif - -#if !defined(__CYGWIN32__) - environ = save_environ; -#endif - } - - if (pid < 0) - { - close_descriptor_pair (forkin, forkout); - report_file_error ("Doing fork", Qnil); - } + pid = PROCMETH (create_process, (p, new_argv, current_dir)); p->pid = make_int (pid); - /* #### dmoore - why is this commented out, otherwise we leave - subtty = forkin, but then we close forkin just below. */ - /* p->subtty = -1; */ - -#ifdef WINDOWSNT - register_child (pid, inchannel); -#endif /* WINDOWSNT */ - - /* If the subfork execv fails, and it exits, - this close hangs. I don't know why. - So have an interrupt jar it loose. */ - if (forkin >= 0) - close_safely (forkin); - if (forkin != forkout && forkout >= 0) - close (forkout); - -#ifdef HAVE_PTYS - if (pty_flag) - XPROCESS (process)->tty_name = build_string (pty_name); - else -#endif - XPROCESS (process)->tty_name = Qnil; - - /* Notice that SIGCHLD was not blocked. (This is not possible on - some systems.) No biggie if SIGCHLD occurs right around the - time that this call happens, because SIGCHLD() does not actually - deselect the process (that doesn't occur until the next time - we're waiting for an event, when status_notify() is called). */ - event_stream_select_process (XPROCESS (process)); - - return; - -io_failure: - { - int temp = errno; - close_descriptor_pair (forkin, forkout); - close_descriptor_pair (inchannel, outchannel); - errno = temp; - report_file_error ("Opening pty or pipe", Qnil); - } + if (!NILP(p->pipe_instream)) + event_stream_select_process (p); } /* This function is the unwind_protect form for Fstart_process_internal. If @@ -1217,117 +642,27 @@ } -/* connect to an existing file descriptor. This is very similar to - open-network-stream except that it assumes that the connection has - already been initialized. It is currently used for ToolTalk - communication. */ - -/* This function used to be visible on the Lisp level, but there is no - real point in doing that. Here is the doc string: - - "Connect to an existing file descriptor.\n\ -Returns a subprocess-object to represent the connection.\n\ -Input and output work as for subprocesses; `delete-process' closes it.\n\ -Args are NAME BUFFER INFD OUTFD.\n\ -NAME is name for process. It is modified if necessary to make it unique.\n\ -BUFFER is the buffer (or buffer-name) to associate with the process.\n\ - Process output goes at end of that buffer, unless you specify\n\ - an output stream or filter function to handle the output.\n\ - BUFFER may be also nil, meaning that this process is not associated\n\ - with any buffer\n\ -INFD and OUTFD specify the file descriptors to use for input and\n\ - output, respectively." -*/ - -Lisp_Object -connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer, - Lisp_Object infd, Lisp_Object outfd) -{ - /* This function can GC */ - Lisp_Object proc; - int inch; - - CHECK_STRING (name); - CHECK_INT (infd); - CHECK_INT (outfd); - - inch = XINT (infd); - if (!NILP (descriptor_to_process[inch])) - error ("There is already a process connected to fd %d", inch); - if (!NILP (buffer)) - buffer = Fget_buffer_create (buffer); - proc = make_process_internal (name); - - descriptor_to_process[inch] = proc; - - XPROCESS (proc)->pid = Fcons (infd, name); - XPROCESS (proc)->buffer = buffer; - init_process_fds (XPROCESS (proc), inch, XINT (outfd)); - XPROCESS (proc)->connected_via_filedesc_p = 1; - - event_stream_select_process (XPROCESS (proc)); - - return proc; -} - - #ifdef HAVE_SOCKETS -static int -get_internet_address (Lisp_Object host, struct sockaddr_in *address, - Error_behavior errb) -{ - struct hostent *host_info_ptr = NULL; -#ifdef TRY_AGAIN - int count = 0; -#endif - memset (address, 0, sizeof (*address)); +/* #### The network support is fairly synthetical. What we actually + need is a single function, which supports all datagram, stream and + packet stream connections, arbitrary protocol families should they + be supported by the target system, multicast groups, in both data + and control rooted/nonrooted flavors, service quality etc whatever + is supported by the underlying network. - while (1) - { -#ifdef TRY_AGAIN - if (count++ > 10) break; -#ifndef BROKEN_CYGWIN - h_errno = 0; -#endif -#endif - /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */ - slow_down_interrupts (); - host_info_ptr = gethostbyname ((char *) XSTRING_DATA (host)); - speed_up_interrupts (); -#ifdef TRY_AGAIN - if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN)) -#endif - break; - Fsleep_for (make_int (1)); - } - if (host_info_ptr) - { - address->sin_family = host_info_ptr->h_addrtype; - memcpy (&address->sin_addr, host_info_ptr->h_addr, host_info_ptr->h_length); - } - else - { - IN_ADDR numeric_addr; - /* Attempt to interpret host as numeric inet address */ - numeric_addr = inet_addr ((char *) XSTRING_DATA (host)); - if (NUMERIC_ADDR_ERROR) - { - maybe_error (Qprocess, errb, - "Unknown host \"%s\"", XSTRING_DATA (host)); - return 0; - } + It must accept a property list describing the connection. The current + functions must then go to lisp and provide a suitable list for the + generalized connection function. - /* There was some broken code here that called strlen() here - on (char *) &numeric_addr and even sometimes accessed - uninitialized data. */ - address->sin_family = AF_INET; - * (IN_ADDR *) &address->sin_addr = numeric_addr; - } + Both UNIX ans Win32 support BSD sockets, and there are many extensions + availalble (Sockets 2 spec). - return 1; -} + A todo is define a consistent set of properties abstracting a + network connection. -kkm +*/ + /* open a TCP network connection to a given HOST/SERVICE. Treated exactly like a normal process when reading and writing. Only @@ -1335,7 +670,7 @@ connection has no PID; you cannot signal it. All you can do is deactivate and close it via delete-process */ -DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 4, 0, /* +DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /* Open a TCP connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. @@ -1349,186 +684,48 @@ Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. +Fifth argument FAMILY is a protocol family. When omitted, 'tcp/ip +(Internet protocol family TCP/IP) is assumed. */ - (name, buffer, host, service)) + (name, buffer, host, service, family)) { /* !!#### This function has not been Mule-ized */ /* This function can GC */ - Lisp_Object proc; - struct sockaddr_in address; - int s, outch, inch; - volatile int port; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - volatile int retry = 0; - int retval; + Lisp_Object proc = Qnil; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; + void *inch, *outch; - GCPRO4 (name, buffer, host, service); + GCPRO5 (name, buffer, host, service, family); CHECK_STRING (name); - CHECK_STRING (host); - if (INTP (service)) - port = htons ((unsigned short) XINT (service)); - else - { - struct servent *svc_info; - CHECK_STRING (service); - svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); - if (svc_info == 0) -#ifdef WIN32 - error ("Unknown service \"%s\" (%d)", - XSTRING_DATA (service), WSAGetLastError ()); -#else - error ("Unknown service \"%s\"", XSTRING_DATA (service)); -#endif - port = svc_info->s_port; - } - - get_internet_address (host, &address, ERROR_ME); - address.sin_port = port; - - s = socket (address.sin_family, SOCK_STREAM, 0); - if (s < 0) - report_file_error ("error creating socket", list1 (name)); - - /* Turn off interrupts here -- see comments below. There used to - be code which called bind_polling_period() to slow the polling - period down rather than turn it off, but that seems rather - bogus to me. Best thing here is to use a non-blocking connect - or something, to check for QUIT. */ - - /* Comments that are not quite valid: */ - - /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) - when connect is interrupted. So let's not let it get interrupted. - Note we do not turn off polling, because polling is only used - when not interrupt_input, and thus not normally used on the systems - which have this bug. On systems which use polling, there's no way - to quit if polling is turned off. */ - - /* Slow down polling. Some kernels have a bug which causes retrying - connect to fail after a connect. */ - - slow_down_interrupts (); - loop: - - /* A system call interrupted with a SIGALRM or SIGIO comes back - here, with can_break_system_calls reset to 0. */ - SETJMP (break_system_call_jump); - if (QUITP) - { - speed_up_interrupts (); - REALLY_QUIT; - /* In case something really weird happens ... */ - slow_down_interrupts (); - } + if (NILP(family)) + family = Qtcpip; + else + CHECK_SYMBOL (family); - /* Break out of connect with a signal (it isn't otherwise possible). - Thus you don't get screwed with a hung network. */ - can_break_system_calls = 1; - retval = connect (s, (struct sockaddr *) &address, sizeof (address)); - can_break_system_calls = 0; - if (retval == -1 && errno != EISCONN) - { - int xerrno = errno; - if (errno == EINTR) - goto loop; - if (errno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - and should be infrequent. - `sleep-for' allowed for quitting this loop with interrupts - slowed down so it can't be used here. Async timers should - already be disabled at this point so we can use `sleep'. */ - sleep (1); - retry++; - goto loop; - } - - close (s); - - speed_up_interrupts (); - - errno = xerrno; - report_file_error ("connection failed", list2 (host, name)); - } - - speed_up_interrupts (); - - inch = s; - outch = dup (s); - if (outch < 0) - { - close (s); /* this used to be leaked; from Kyle Jones */ - report_file_error ("error duplicating socket", list1 (name)); - } - + /* Since this code is inside HAVE_SOCKETS, existence of + open_network_stream is mandatory */ + PROCMETH (open_network_stream, (name, host, service, family, + &inch, &outch)); + if (!NILP (buffer)) buffer = Fget_buffer_create (buffer); proc = make_process_internal (name); - - descriptor_to_process[inch] = proc; - -#ifdef PROCESS_IO_BLOCKING - { - Lisp_Object tail; - - for (tail = network_stream_blocking_port_list; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object tail_port = XCAR (tail); - - if (STRINGP (tail_port)) - { - struct servent *svc_info; - CHECK_STRING (tail_port); - svc_info = getservbyname ((char *) XSTRING_DATA (tail_port), "tcp"); - if ((svc_info != 0) && (svc_info->s_port == port)) - break; - else - continue; - } - else if ((INTP (tail_port)) && (htons ((unsigned short) XINT (tail_port)) == port)) - break; - } - - if (!CONSP (tail)) - { -#endif /* PROCESS_IO_BLOCKING */ - set_descriptor_non_blocking (inch); -#ifdef PROCESS_IO_BLOCKING - } - } -#endif /* PROCESS_IO_BLOCKING */ + NGCPRO1 (proc); XPROCESS (proc)->pid = Fcons (service, host); XPROCESS (proc)->buffer = buffer; - init_process_fds (XPROCESS (proc), inch, outch); - XPROCESS (proc)->connected_via_filedesc_p = 0; + init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, 0); event_stream_select_process (XPROCESS (proc)); UNGCPRO; + NUNGCPRO; return proc; } #ifdef HAVE_MULTICAST -/* Didier Verna <verna@inf.enst.fr> Nov. 28 1997. - This function is similar to open-network-stream-internal, but provides a - mean to open an UDP multicast connection instead of a TCP one. Like in the - TCP case, the multicast connection will be seen as a sub-process, - - Some notes: - - Normaly, we should use sendto and recvfrom with non connected - sockets. The current code doesn't allow us to do this. In the future, it - would be a good idea to extend the process data structure in order to deal - properly with the different types network connections. - - For the same reason, when leaving a multicast group, it is better to make - a setsockopt - IP_DROP_MEMBERSHIP before closing the descriptors. - Unfortunately, this can't be done here because delete_process doesn't know - about the kind of connection we have. However, this is not such an - important issue. -*/ DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* Open a multicast connection on the specified dest/port/ttl. Returns a subprocess-object to represent the connection. @@ -1549,138 +746,16 @@ { /* !!#### This function has not been Mule-ized */ /* This function can GC */ - Lisp_Object proc; - struct ip_mreq imr; - struct sockaddr_in sa; - struct protoent *udp; - int ws, rs; - int theport; - unsigned char thettl; - int one = 1; /* For REUSEADDR */ - int ret; - volatile int retry = 0; + Lisp_Object proc = Qnil; struct gcpro gcpro1; - - CHECK_STRING (name); - CHECK_STRING (dest); - - CHECK_NATNUM (port); - theport = htons ((unsigned short) XINT (port)); - - CHECK_NATNUM (ttl); - thettl = (unsigned char) XINT (ttl); - - if ((udp = getprotobyname ("udp")) == NULL) - error ("No info available for UDP protocol"); - - /* Init the sockets. Yes, I need 2 sockets. I couldn't duplicate one. */ - if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) - report_file_error ("error creating socket", list1(name)); - if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) - { - close (rs); - report_file_error ("error creating socket", list1(name)); - } - - /* This will be used for both sockets */ - bzero(&sa, sizeof(sa)); - sa.sin_family = AF_INET; - sa.sin_port = theport; - sa.sin_addr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); + void *inch, *outch; - /* Socket configuration for reading ------------------------ */ - - /* Multiple connections from the same machine. This must be done before - bind. If it fails, it shouldn't be fatal. The only consequence is that - people won't be able to connect twice from the same machine. */ - if (setsockopt (rs, SOL_SOCKET, SO_REUSEADDR, (char *) &one, sizeof (one)) - < 0) - warn_when_safe (Qmulticast, Qwarning, "Cannot reuse socket address"); - - /* bind socket name */ - if (bind (rs, (struct sockaddr *)&sa, sizeof(sa))) - { - close (rs); - close (ws); - report_file_error ("error binding socket", list2(name, port)); - } - - /* join multicast group */ - imr.imr_multiaddr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); - imr.imr_interface.s_addr = htonl (INADDR_ANY); - if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP, - (char *) &imr, sizeof (struct ip_mreq)) < 0) - { - close (ws); - close (rs); - report_file_error ("error adding membership", list2(name, dest)); - } - - /* Socket configuration for writing ----------------------- */ - - /* Normaly, there's no 'connect' in multicast, since we use preferentialy - 'sendto' and 'recvfrom'. However, in order to handle this connection in - the process-like way it is done for TCP, we must be able to use 'write' - instead of 'sendto'. Consequently, we 'connect' this socket. */ - - /* See open-network-stream-internal for comments on this part of the code */ - slow_down_interrupts (); - - loop: - - /* A system call interrupted with a SIGALRM or SIGIO comes back - here, with can_break_system_calls reset to 0. */ - SETJMP (break_system_call_jump); - if (QUITP) - { - speed_up_interrupts (); - REALLY_QUIT; - /* In case something really weird happens ... */ - slow_down_interrupts (); - } - - /* Break out of connect with a signal (it isn't otherwise possible). - Thus you don't get screwed with a hung network. */ - can_break_system_calls = 1; - ret = connect (ws, (struct sockaddr *) &sa, sizeof (sa)); - can_break_system_calls = 0; - if (ret == -1 && errno != EISCONN) - { - int xerrno = errno; - - if (errno == EINTR) - goto loop; - if (errno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - and should be infrequent. - `sleep-for' allowed for quitting this loop with interrupts - slowed down so it can't be used here. Async timers should - already be disabled at this point so we can use `sleep'. */ - sleep (1); - retry++; - goto loop; - } - - close (rs); - close (ws); - speed_up_interrupts (); - - errno = xerrno; - report_file_error ("error connecting socket", list2(name, port)); - } - - speed_up_interrupts (); - - /* scope */ - if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL, - (char *) &thettl, sizeof (thettl)) < 0) - { - close (rs); - close (ws); - report_file_error ("error setting ttl", list2(name, ttl)); - } + CHECK_STRING (name); + + /* Since this code is inside HAVE_MULTICAST, existence of + open_network_stream is mandatory */ + PROCMETH (open_multicast_group, (name, dest, port, ttl, + &inch, &outch)); if (!NILP (buffer)) buffer = Fget_buffer_create (buffer); @@ -1688,46 +763,9 @@ proc = make_process_internal (name); GCPRO1 (proc); - descriptor_to_process[rs] = proc; - -#ifdef PROCESS_IO_BLOCKING - { - Lisp_Object tail; - - for (tail = network_stream_blocking_port_list; - CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object tail_port = XCAR (tail); - - if (STRINGP (tail_port)) - { - struct servent *svc_info; - - svc_info = - getservbyname ((char *) XSTRING_DATA (tail_port), "udp"); - if ((svc_info != 0) && (svc_info->s_port == theport)) - break; - else - continue; - } - else if ((INTP (tail_port)) && - (htons ((unsigned short) XINT (tail_port)) == theport)) - break; - } - - if (!CONSP (tail)) - { -#endif /* PROCESS_IO_BLOCKING */ - set_descriptor_non_blocking (rs); -#ifdef PROCESS_IO_BLOCKING - } - } -#endif /* PROCESS_IO_BLOCKING */ - XPROCESS (proc)->pid = Fcons (port, dest); XPROCESS (proc)->buffer = buffer; - init_process_fds (XPROCESS (proc), rs, ws); - XPROCESS (proc)->connected_via_filedesc_p = 0; + init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, 0); event_stream_select_process (XPROCESS (proc)); @@ -1741,21 +779,7 @@ Lisp_Object canonicalize_host_name (Lisp_Object host) { -#ifdef HAVE_SOCKETS - /* #### for HAVE_TERM, you probably have to do something else. */ - struct sockaddr_in address; - - if (!get_internet_address (host, &address, ERROR_ME_NOT)) - return host; - - if (address.sin_family == AF_INET) - return build_string (inet_ntoa (address.sin_addr)); - else - /* #### any clue what to do here? */ - return host; -#else - return host; -#endif + return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host); } @@ -1767,11 +791,9 @@ CHECK_PROCESS (proc); CHECK_NATNUM (height); CHECK_NATNUM (width); - if (set_window_size (XPROCESS (proc)->infd, XINT (height), XINT (width)) - <= 0) - return Qnil; - else - return Qt; + return + MAYBE_INT_PROCMETH (set_window_size, (XPROCESS (proc), XINT (height), XINT (width))) <= 0 + ? Qnil : Qt; } @@ -1779,11 +801,6 @@ /* Process I/O */ /************************************************************************/ -/* (Faccept_process_output is now in event-stream.c) */ - -/* Some FSFmacs error handlers here. We handle this - in call2_trapping_errors(). */ - /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of characters read. @@ -1809,7 +826,7 @@ Really, the loop in execute_internal_event() should check itself for a process-filter change, like in status_notify(); but the struct Lisp_Process is not exported outside of this file. */ - if (p->infd < 0) + if (NILP(p->pipe_instream)) return -1; /* already closed */ if (!NILP (p->filter) && (p->filter_does_read)) @@ -1827,32 +844,7 @@ return XINT (filter_result); } -#if 0 /* FSFmacs */ - /* #### equivalent code from FSFmacs. Would need some porting - for Windows NT. */ - if (proc_buffered_char[channel] < 0) -#ifdef WINDOWSNT - nchars = read_child_output (channel, chars, sizeof (chars)); -#else - nchars = read (channel, chars, sizeof chars); -#endif - else - { - chars[0] = proc_buffered_char[channel]; - proc_buffered_char[channel] = -1; -#ifdef WINDOWSNT - nchars = read_child_output (channel, chars + 1, sizeof (chars) - 1); -#else - nchars = read (channel, chars + 1, sizeof chars - 1); -#endif - if (nchars < 0) - nchars = 1; - else - nchars = nchars + 1; - } -#endif /* FSFmacs */ - - nbytes = Lstream_read (XLSTREAM (p->instream), chars, sizeof (chars)); + nbytes = Lstream_read (XLSTREAM (DATA_INSTREAM(p)), chars, sizeof (chars)); if (nbytes <= 0) return nbytes; nchars = bytecount_to_charcount (chars, nbytes); @@ -1956,19 +948,9 @@ } return nchars; } - + /* Sending data to subprocess */ -static JMP_BUF send_process_frame; - -static SIGTYPE -send_process_trap (int signum) -{ - EMACS_REESTABLISH_SIGNAL (signum, send_process_trap); - EMACS_UNBLOCK_SIGNAL (signum); - LONGJMP (send_process_frame, 1); -} - /* send some data to process PROC. If NONRELOCATABLE is non-NULL, it specifies the address of the data. Otherwise, the data comes from the object RELOCATABLE (either a string or a buffer). START and LEN @@ -1977,27 +959,18 @@ Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer, and in Bytecounts otherwise. */ -static void -send_process (volatile Lisp_Object proc, +void +send_process (Lisp_Object proc, Lisp_Object relocatable, CONST Bufbyte *nonrelocatable, int start, int len) { /* This function can GC */ - /* Use volatile to protect variables from being clobbered by longjmp. */ struct gcpro gcpro1, gcpro2; - SIGTYPE (*volatile old_sigpipe) (int) = 0; Lisp_Object lstream = Qnil; - volatile struct Lisp_Process *p = XPROCESS (proc); -#if defined (NO_UNION_TYPE) /* || !defined (__GNUC__) GCC bug only??? */ - /* #### ugh! There must be a better solution. */ - Lisp_Object defeat_volatile_kludge = (Lisp_Object) proc; -#else - Lisp_Object defeat_volatile_kludge = proc; -#endif - GCPRO2 (defeat_volatile_kludge, lstream); + GCPRO2 (proc, lstream); - if (p->outfd < 0) + if (NILP (DATA_OUTSTREAM (XPROCESS (proc)))) signal_simple_error ("Process not open for writing", proc); if (nonrelocatable) @@ -2009,63 +982,8 @@ else lstream = make_lisp_string_input_stream (relocatable, start, len); - if (!SETJMP (send_process_frame)) - { - /* use a reasonable-sized buffer (somewhere around the size of the - stream buffer) so as to avoid inundating the stream with blocked - data. */ - Bufbyte chunkbuf[512]; - Bytecount chunklen; - - while (1) - { - int writeret; + PROCMETH (send_process, (proc, XLSTREAM (lstream))); - chunklen = Lstream_read (XLSTREAM (lstream), chunkbuf, 512); - if (chunklen <= 0) - break; /* perhaps should abort() if < 0? - This should never happen. */ - old_sigpipe = - (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); - /* Lstream_write() will never successfully write less than - the amount sent in. In the worst case, it just buffers - the unwritten data. */ - writeret = Lstream_write (XLSTREAM (p->outstream), chunkbuf, - chunklen); - signal (SIGPIPE, old_sigpipe); - if (writeret < 0) - /* This is a real error. Blocking errors are handled - specially inside of the filedesc stream. */ - report_file_error ("writing to process", - list1 (proc)); - while (filedesc_stream_was_blocked (XLSTREAM (p->filedesc_stream))) - { - /* Buffer is full. Wait, accepting input; - that may allow the program - to finish doing output and read more. */ - Faccept_process_output (Qnil, make_int (1), Qnil); - old_sigpipe = - (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); - Lstream_flush (XLSTREAM (p->filedesc_stream)); - signal (SIGPIPE, old_sigpipe); - } - } - } - else - { /* We got here from a longjmp() from the SIGPIPE handler */ - signal (SIGPIPE, old_sigpipe); - p->status_symbol = Qexit; - p->exit_code = 256; /* #### SIGPIPE ??? */ - p->core_dumped = 0; - p->tick++; - process_tick++; - deactivate_process (proc); - error ("SIGPIPE raised on process %s; closed it", - XSTRING_DATA (p->name)); - } - old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); - Lstream_flush (XLSTREAM (p->outstream)); - signal (SIGPIPE, old_sigpipe); UNGCPRO; Lstream_delete (XLSTREAM (lstream)); } @@ -2078,7 +996,7 @@ (proc)) { CHECK_PROCESS (proc); - return XPROCESS (proc)->tty_name; + return MAYBE_LISP_PROCMETH (get_tty_name, (XPROCESS (proc))); } DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* @@ -2206,7 +1124,7 @@ (process)) { process = get_process (process); - return decoding_stream_coding_system (XLSTREAM ( XPROCESS (process)->instream) ); + return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) ); } DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* @@ -2215,7 +1133,7 @@ (process)) { process = get_process (process); - return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->outstream)); + return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream)); } DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* @@ -2225,9 +1143,9 @@ { process = get_process (process); return Fcons (decoding_stream_coding_system - (XLSTREAM (XPROCESS (process)->instream)), + (XLSTREAM (XPROCESS (process)->coding_instream)), encoding_stream_coding_system - (XLSTREAM (XPROCESS (process)->outstream))); + (XLSTREAM (XPROCESS (process)->coding_outstream))); } DEFUN ("set-process-input-coding-system", @@ -2238,7 +1156,7 @@ { codesys = Fget_coding_system (codesys); process = get_process (process); - set_decoding_stream_coding_system ( XLSTREAM ( XPROCESS (process)->instream ), codesys); + set_decoding_stream_coding_system ( XLSTREAM ( XPROCESS (process)->coding_instream ), codesys); return Qnil; } @@ -2251,7 +1169,7 @@ codesys = Fget_coding_system (codesys); process = get_process (process); set_encoding_stream_coding_system - ( XLSTREAM ( XPROCESS (process)->outstream), codesys); + ( XLSTREAM ( XPROCESS (process)->coding_outstream), codesys); return Qnil; } @@ -2270,16 +1188,12 @@ return Qnil; } -#endif - +#endif /* FILE_CODING */ /************************************************************************/ /* process status */ /************************************************************************/ -/* Some FSFmacs error handlers here. We handle this - in call2_trapping_errors(). */ - static Lisp_Object exec_sentinel_unwind (Lisp_Object datum) { @@ -2348,40 +1262,6 @@ return (CONST char *) GETTEXT ("unknown signal"); } -/* Compute the Lisp form of the process status from - the numeric status that was returned by `wait'. */ - -static void -update_status_from_wait_code (struct Lisp_Process *p, int *w_fmh) -{ - /* C compiler lossage when attempting to pass w directly */ - int w = *w_fmh; - - if (WIFSTOPPED (w)) - { - p->status_symbol = Qstop; - p->exit_code = WSTOPSIG (w); - p->core_dumped = 0; - } - else if (WIFEXITED (w)) - { - p->status_symbol = Qexit; - p->exit_code = WEXITSTATUS (w); - p->core_dumped = 0; - } - else if (WIFSIGNALED (w)) - { - p->status_symbol = Qsignal; - p->exit_code = WTERMSIG (w); - p->core_dumped = WCOREDUMP (w); - } - else - { - p->status_symbol = Qrun; - p->exit_code = 0; - } -} - void update_process_status (Lisp_Object p, Lisp_Object status_symbol, @@ -2395,212 +1275,6 @@ XPROCESS (p)->core_dumped = core_dumped; } -#ifdef SIGCHLD - -#define MAX_EXITED_PROCESSES 1000 -static volatile pid_t exited_processes[MAX_EXITED_PROCESSES]; -static volatile int exited_processes_status[MAX_EXITED_PROCESSES]; -static volatile int exited_processes_index; - -static volatile int sigchld_happened; - -/* For any processes that have changed status and are recorded - and such, update the corresponding struct Lisp_Process. - We separate this from record_exited_processes() so that - we never have to call this function from within a signal - handler. We block SIGCHLD in case record_exited_processes() - is called from a signal handler. */ - -static void -reap_exited_processes (void) -{ - int i; - struct Lisp_Process *p; - - if (exited_processes_index <= 0) - { - return; - } - -#ifdef EMACS_BLOCK_SIGNAL - EMACS_BLOCK_SIGNAL (SIGCHLD); -#endif - for (i = 0; i < exited_processes_index; i++) - { - int pid = exited_processes[i]; - int w = exited_processes_status[i]; - - /* Find the process that signaled us, and record its status. */ - - p = 0; - { - Lisp_Object tail; - LIST_LOOP (tail, Vprocess_list) - { - Lisp_Object proc = XCAR (tail); - p = XPROCESS (proc); - if (INTP (p->pid) && XINT (p->pid) == pid) - break; - p = 0; - } - } - - if (p) - { - /* Change the status of the process that was found. */ - p->tick++; - process_tick++; - update_status_from_wait_code (p, &w); - - /* If process has terminated, stop waiting for its output. */ - if (WIFSIGNALED (w) || WIFEXITED (w)) - { - if (p->infd >= 0) - { - /* We can't just call event_stream->unselect_process_cb (p) - here, because that calls XtRemoveInput, which is not - necessarily reentrant, so we can't call this at interrupt - level. - */ - } - } - } - else - { - /* There was no asynchronous process found for that id. Check - if we have a synchronous process. Only set sync process status - if there is one, so we work OK with the waitpid() call in - wait_for_termination(). */ - if (synch_process_alive != 0) - { /* Set the global sync process status variables. */ - synch_process_alive = 0; - - /* Report the status of the synchronous process. */ - if (WIFEXITED (w)) - synch_process_retcode = WEXITSTATUS (w); - else if (WIFSIGNALED (w)) - synch_process_death = signal_name (WTERMSIG (w)); - } - } - } - - exited_processes_index = 0; - - EMACS_UNBLOCK_SIGNAL (SIGCHLD); -} - -/* On receipt of a signal that a child status has changed, - loop asking about children with changed statuses until - the system says there are no more. All we do is record - the processes and wait status. - - This function could be called from within the SIGCHLD - handler, so it must be completely reentrant. When - not called from a SIGCHLD handler, BLOCK_SIGCHLD should - be non-zero so that SIGCHLD is blocked while this - function is running. (This is necessary so avoid - race conditions with the SIGCHLD_HAPPENED flag). */ - -static void -record_exited_processes (int block_sigchld) -{ - if (!sigchld_happened) - { - return; - } - -#ifdef EMACS_BLOCK_SIGNAL - if (block_sigchld) - EMACS_BLOCK_SIGNAL (SIGCHLD); -#endif - - while (sigchld_happened) - { - int pid; - int w; - - /* Keep trying to get a status until we get a definitive result. */ - do - { - errno = 0; -#ifdef WNOHANG -# ifndef WUNTRACED -# define WUNTRACED 0 -# endif /* not WUNTRACED */ -# ifdef HAVE_WAITPID - pid = waitpid ((pid_t) -1, &w, WNOHANG | WUNTRACED); -# else - pid = wait3 (&w, WNOHANG | WUNTRACED, 0); -# endif -#else /* not WNOHANG */ - pid = wait (&w); -#endif /* not WNOHANG */ - } - while (pid <= 0 && errno == EINTR); - - if (pid <= 0) - break; - - if (exited_processes_index < MAX_EXITED_PROCESSES) - { - exited_processes[exited_processes_index] = pid; - exited_processes_status[exited_processes_index] = w; - exited_processes_index++; - } - - /* On systems with WNOHANG, we just ignore the number - of times that SIGCHLD was signalled, and keep looping - until there are no more processes to wait on. If we - don't have WNOHANG, we have to rely on the count in - SIGCHLD_HAPPENED. */ -#ifndef WNOHANG - sigchld_happened--; -#endif /* not WNOHANG */ - } - - sigchld_happened = 0; - - if (block_sigchld) - EMACS_UNBLOCK_SIGNAL (SIGCHLD); -} - -/** USG WARNING: Although it is not obvious from the documentation - in signal(2), on a USG system the SIGCLD handler MUST NOT call - signal() before executing at least one wait(), otherwise the handler - will be called again, resulting in an infinite loop. The relevant - portion of the documentation reads "SIGCLD signals will be queued - and the signal-catching function will be continually reentered until - the queue is empty". Invoking signal() causes the kernel to reexamine - the SIGCLD queue. Fred Fish, UniSoft Systems Inc. - - (Note that now this only applies in SYS V Release 2 and before. - On SYS V Release 3, we use sigset() to set the signal handler for - the first time, and so we don't have to reestablish the signal handler - in the handler below. On SYS V Release 4, we don't get this weirdo - behavior when we use sigaction(), which we do use.) */ - -static SIGTYPE -sigchld_handler (int signo) -{ -#ifdef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR - int old_errno = errno; - - sigchld_happened++; - record_exited_processes (0); - errno = old_errno; -#else - sigchld_happened++; -#endif -#ifdef HAVE_UNIXOID_EVENT_LOOP - signal_fake_event (); -#endif - /* WARNING - must come after wait3() for USG systems */ - EMACS_REESTABLISH_SIGNAL (signo, sigchld_handler); - SIGRETURN; -} - -#endif /* SIGCHLD */ - /* Return a string describing a process status list. */ static Lisp_Object @@ -2649,6 +1323,7 @@ process_tick++; } + /* Report all recent events of a change in process status (either run the sentinel or output a message). This is done while Emacs is waiting for keyboard input. */ @@ -2671,12 +1346,7 @@ stuff in -- it can't hurt.) */ int temp_process_tick; -#ifdef SIGCHLD -#ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR - record_exited_processes (1); -#endif - reap_exited_processes (); -#endif + MAYBE_PROCMETH (reap_exited_processes, ()); temp_process_tick = process_tick; @@ -2696,26 +1366,12 @@ /* p->tick is also volatile. Same thing as above applies. */ int this_process_tick; -#ifdef HAVE_WAITPID /* #### extra check for terminated processes, in case a SIGCHLD got missed (this seems to happen sometimes, I'm not sure why). */ - { - int w; -#ifdef SIGCHLD - EMACS_BLOCK_SIGNAL (SIGCHLD); -#endif - if (INTP (p->pid) && - waitpid (XINT (p->pid), &w, WNOHANG) == XINT (p->pid)) - { - p->tick++; - update_status_from_wait_code (p, &w); - } -#ifdef SIGCHLD - EMACS_UNBLOCK_SIGNAL (SIGCHLD); -#endif - } -#endif + if (INTP (p->pid)) + MAYBE_PROCMETH (update_status_if_terminated, (p)); + this_process_tick = p->tick; if (this_process_tick != p->update_tick) { @@ -2851,83 +1507,7 @@ } -#ifdef SIGNALS_VIA_CHARACTERS -/* Get signal character to send to process if SIGNALS_VIA_CHARACTERS */ -static int -process_signal_char (int tty_fd, int signo) -{ - /* If it's not a tty, pray that these default values work */ - if (!isatty(tty_fd)) { -#define CNTL(ch) (037 & (ch)) - switch (signo) - { - case SIGINT: return CNTL('C'); - case SIGQUIT: return CNTL('\\'); -#ifdef SIGTSTP - case SIGTSTP: return CNTL('Z'); -#endif - } - } - -#ifdef HAVE_TERMIOS - /* TERMIOS is the latest and bestest, and seems most likely to work. - If the system has it, use it. */ - { - struct termios t; - tcgetattr (tty_fd, &t); - switch (signo) - { - case SIGINT: return t.c_cc[VINTR]; - case SIGQUIT: return t.c_cc[VQUIT]; -# if defined (VSWTCH) && !defined (PREFER_VSUSP) - case SIGTSTP: return t.c_cc[VSWTCH]; -# else - case SIGTSTP: return t.c_cc[VSUSP]; -# endif - } - } - -# elif defined (TIOCGLTC) && defined (TIOCGETC) /* not HAVE_TERMIOS */ - { - /* On Berkeley descendants, the following IOCTL's retrieve the - current control characters. */ - struct tchars c; - struct ltchars lc; - switch (signo) - { - case SIGINT: ioctl (tty_fd, TIOCGETC, &c); return c.t_intrc; - case SIGQUIT: ioctl (tty_fd, TIOCGETC, &c); return c.t_quitc; -# ifdef SIGTSTP - case SIGTSTP: ioctl (tty_fd, TIOCGLTC, &lc); return lc.t_suspc; -# endif /* SIGTSTP */ - } - } - -# elif defined (TCGETA) /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ - { - /* On SYSV descendants, the TCGETA ioctl retrieves the current - control characters. */ - struct termio t; - ioctl (tty_fd, TCGETA, &t); - switch (signo) { - case SIGINT: return t.c_cc[VINTR]; - case SIGQUIT: return t.c_cc[VQUIT]; -# ifdef SIGTSTP - case SIGTSTP: return t.c_cc[VSWTCH]; -# endif /* SIGTSTP */ - } - } -# else /* ! defined (TCGETA) */ -#error ERROR! Using SIGNALS_VIA_CHARACTERS, but not HAVE_TERMIOS || (TIOCGLTC && TIOCGETC) || TCGETA - /* If your system configuration files define SIGNALS_VIA_CHARACTERS, - you'd better be using one of the alternatives above! */ -# endif /* ! defined (TCGETA) */ - return '\0'; -} -#endif /* SIGNALS_VIA_CHARACTERS */ - - /* send a signal number SIGNO to PROCESS. CURRENT_GROUP means send to the process group that currently owns the terminal being used to communicate with PROCESS. @@ -2940,111 +1520,20 @@ their uid, for which killpg would return an EPERM error. */ static void -process_send_signal (Lisp_Object process0, int signo, +process_send_signal (Lisp_Object process, int signo, int current_group, int nomsg) { /* This function can GC */ - Lisp_Object proc = get_process (process0); - struct Lisp_Process *p = XPROCESS (proc); - int gid; - int no_pgrp = 0; + Lisp_Object proc = get_process (process); if (network_connection_p (proc)) error ("Network connection %s is not a subprocess", - XSTRING_DATA (p->name)); - if (p->infd < 0) + XSTRING_DATA (XPROCESS(proc)->name)); + if (!PROCESS_LIVE_P (proc)) error ("Process %s is not active", - XSTRING_DATA (p->name)); - - if (!p->pty_flag) - current_group = 0; - - /* If we are using pgrps, get a pgrp number and make it negative. */ - if (current_group) - { -#ifdef SIGNALS_VIA_CHARACTERS - /* If possible, send signals to the entire pgrp - by sending an input character to it. */ - { - char sigchar = process_signal_char(p->subtty, signo); - if (sigchar) { - send_process (proc, Qnil, (Bufbyte *) &sigchar, 0, 1); - return; - } - } -#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */ - -#ifdef TIOCGPGRP - /* Get the pgrp using the tty itself, if we have that. - Otherwise, use the pty to get the pgrp. - On pfa systems, saka@pfu.fujitsu.co.JP writes: - "TIOCGPGRP symbol defined in sys/ioctl.h at E50. - But, TIOCGPGRP does not work on E50 ;-P works fine on E60" - His patch indicates that if TIOCGPGRP returns an error, then - we should just assume that p->pid is also the process group id. */ - { - int err; - - err = ioctl ( (p->subtty != -1 ? p->subtty : p->infd), TIOCGPGRP, &gid); + XSTRING_DATA (XPROCESS(proc)->name)); -#ifdef pfa - if (err == -1) - gid = - XINT (p->pid); -#endif /* ! defined (pfa) */ - } - if (gid == -1) - no_pgrp = 1; - else - gid = - gid; -#else /* ! defined (TIOCGPGRP ) */ - /* Can't select pgrps on this system, so we know that - the child itself heads the pgrp. */ - gid = - XINT (p->pid); -#endif /* ! defined (TIOCGPGRP ) */ - } - else - gid = - XINT (p->pid); - - switch (signo) - { -#ifdef SIGCONT - case SIGCONT: - p->status_symbol = Qrun; - p->exit_code = 0; - p->tick++; - process_tick++; - if (!nomsg) - status_notify (); - break; -#endif /* ! defined (SIGCONT) */ - case SIGINT: - case SIGQUIT: - case SIGKILL: - flush_pending_output (p->infd); - break; - } - - /* If we don't have process groups, send the signal to the immediate - subprocess. That isn't really right, but it's better than any - obvious alternative. */ - if (no_pgrp) - { - kill (XINT (p->pid), signo); - return; - } - - /* gid may be a pid, or minus a pgrp's number */ -#ifdef TIOCSIGSEND - if (current_group) - ioctl (p->infd, TIOCSIGSEND, signo); - else - { - gid = - XINT (p->pid); - kill (gid, signo); - } -#else /* ! defined (TIOCSIGSEND) */ - EMACS_KILLPG (-gid, signo); -#endif /* ! defined (TIOCSIGSEND) */ + MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg)); } DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* @@ -3070,8 +1559,7 @@ (process, current_group)) { /* This function can GC */ - process_send_signal (process, SIGKILL, !NILP (current_group), - 0); + process_send_signal (process, SIGKILL, !NILP (current_group), 0); return process; } @@ -3082,8 +1570,7 @@ (process, current_group)) { /* This function can GC */ - process_send_signal (process, SIGQUIT, !NILP (current_group), - 0); + process_send_signal (process, SIGQUIT, !NILP (current_group), 0); return process; } @@ -3094,11 +1581,10 @@ (process, current_group)) { /* This function can GC */ -#ifndef SIGTSTP - error ("no SIGTSTP support"); +#ifdef SIGTSTP + process_send_signal (process, SIGTSTP, !NILP (current_group), 0); #else - process_send_signal (process, SIGTSTP, !NILP (current_group), - 0); + error ("stop-process: Not supported on this system"); #endif return process; } @@ -3111,10 +1597,9 @@ { /* This function can GC */ #ifdef SIGCONT - process_send_signal (process, SIGCONT, !NILP (current_group), - 0); + process_send_signal (process, SIGCONT, !NILP (current_group), 0); #else - error ("no SIGCONT support"); + error ("continue-process: Not supported on this system"); #endif return process; } @@ -3240,7 +1725,8 @@ #undef handle_signal - return make_int (kill (XINT (pid), XINT (sigcode))); + return make_int (PROCMETH_OR_GIVEN (kill_process_by_pid, + (XINT (pid), XINT (sigcode)), -1)); } DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* @@ -3262,24 +1748,14 @@ if (! EQ (XPROCESS (proc)->status_symbol, Qrun)) error ("Process %s not running", XSTRING_DATA (XPROCESS (proc)->name)); - if (XPROCESS (proc)->pty_flag) + if (!MAYBE_INT_PROCMETH (process_send_eof, (proc))) { - /* #### get_eof_char simply doesn't return the correct character - here. Maybe it is needed to determine the right eof - character in init_process_fds but here it simply screws - things up. */ -#if 0 - Bufbyte eof_char = get_eof_char (XPROCESS (proc)); - send_process (proc, Qnil, &eof_char, 0, 1); -#else - send_process (proc, Qnil, (CONST Bufbyte *) "\004", 0, 1); + event_stream_delete_stream_pair (Qnil, XPROCESS (proc)->pipe_outstream); + XPROCESS (proc)->pipe_outstream = Qnil; +#ifdef FILE_CODING + XPROCESS (proc)->coding_outstream = Qnil; #endif } - else - { - close (XPROCESS (proc)->outfd); - XPROCESS (proc)->outfd = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0); - } return process; } @@ -3292,42 +1768,36 @@ void deactivate_process (Lisp_Object proc) { - int inchannel, outchannel; struct Lisp_Process *p = XPROCESS (proc); - SIGTYPE (*old_sigpipe) (int) = 0; - - inchannel = p->infd; - outchannel = p->outfd; + USID usid; - /* closing the outstream could result in SIGPIPE, so ignore it. */ - old_sigpipe = - (SIGTYPE (*) (int)) signal (SIGPIPE, SIG_IGN); - if (!NILP (p->instream)) - Lstream_close (XLSTREAM (p->instream)); - if (!NILP (p->outstream)) - Lstream_close (XLSTREAM (p->outstream)); - signal (SIGPIPE, old_sigpipe); + /* It's possible that we got as far in the process-creation + process as creating the descriptors but didn't get so + far as selecting the process for input. In this + case, p->pid is nil: p->pid is set at the same time that + the process is selected for input. */ + /* #### The comment does not look correct. event_stream_unselect_process + is guarded by process->selected, so this is not a problem. - kkm*/ + /* Must call this before setting the streams to nil */ + event_stream_unselect_process (p); - if (inchannel >= 0) - { - /* Beware SIGCHLD hereabouts. */ - flush_pending_output (inchannel); - close_descriptor_pair (inchannel, outchannel); - if (!NILP (p->pid)) - { - /* It's possible that we got as far in the process-creation - process as creating the descriptors but didn't get so - far as selecting the process for input. In this - case, p->pid is nil: p->pid is set at the same time that - the process is selected for input. */ - /* Must call this before setting the file descriptors to 0 */ - event_stream_unselect_process (p); - } + /* Provide minimal implementation for deactivate_process + if there's no process-specific one */ + if (HAS_PROCMETH_P (deactivate_process)) + usid = PROCMETH (deactivate_process, (p)); + else + usid = event_stream_delete_stream_pair (p->pipe_instream, + p->pipe_outstream); - p->infd = -1; - p->outfd = -1; - descriptor_to_process[inchannel] = Qnil; - } + if (usid != USID_DONTHASH) + remhash ((CONST void*)usid, usid_to_process); + + p->pipe_instream = Qnil; + p->pipe_outstream = Qnil; +#ifdef FILE_CODING + p->coding_instream = Qnil; + p->coding_outstream = Qnil; +#endif } static void @@ -3357,7 +1827,7 @@ p->tick++; process_tick++; } - else if (p->infd >= 0) + else if (!NILP(p->pipe_instream)) { Fkill_process (proc, Qnil); /* Do this now, since remove_process will make sigchld_handler do nothing. */ @@ -3389,30 +1859,12 @@ { if (network_connection_p (proc)) Fdelete_process (proc); - else if (XPROCESS (proc)->infd >= 0) + else if (!NILP (XPROCESS (proc)->pipe_instream)) process_send_signal (proc, SIGHUP, 0, 1); } } } -#if 0 /* Unused */ -int -count_active_processes (void) -{ - Lisp_Object tail; - int count = 0; - - for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object status = XPROCESS (XCAR (tail))->status_symbol; - if ((EQ (status, Qrun) || EQ (status, Qstop))) - count++; - } - - return count; -} -#endif /* Unused */ - DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* Say no query needed if PROCESS is running when Emacs is exited. Optional second argument if non-nil says to require a query. @@ -3443,23 +1895,10 @@ void init_xemacs_process (void) { - int i; - -#ifdef SIGCHLD -# ifndef CANNOT_DUMP - if (! noninteractive || initialized) -# endif - signal (SIGCHLD, sigchld_handler); -#endif /* SIGCHLD */ + MAYBE_PROCMETH (init_process, ()); Vprocess_list = Qnil; - for (i = 0; i < MAXDESC; i++) - { - descriptor_to_process[i] = Qnil; -#if 0 /* FSFmacs */ - proc_buffered_char[i] = -1; -#endif - } + usid_to_process = make_hashtable (32); } #if 0 @@ -3488,6 +1927,8 @@ defsymbol (&Qopen, "open"); defsymbol (&Qclosed, "closed"); + defsymbol (&Qtcpip, "tcp/ip"); + #ifdef HAVE_MULTICAST defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ #endif @@ -3537,7 +1978,7 @@ DEFSUBR (Fset_process_output_coding_system); DEFSUBR (Fprocess_coding_system); DEFSUBR (Fset_process_coding_system); -#endif +#endif /* FILE_CODING */ } void