X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e18afed7d695edac870ddf55aabc85c0a95a4b5f..f247498ead8b1898decf47537d59965340d6cebd:/src/process.c diff --git a/src/process.c b/src/process.c index cf6d40052a..f7ecd9b05a 100644 --- a/src/process.c +++ b/src/process.c @@ -93,8 +93,8 @@ along with GNU Emacs. If not, see . */ #include "systty.h" #include "window.h" -#include "buffer.h" #include "character.h" +#include "buffer.h" #include "coding.h" #include "process.h" #include "frame.h" @@ -182,9 +182,9 @@ extern int h_errno; #endif /* Number of events of change of status of a process. */ -static int process_tick; +static EMACS_INT process_tick; /* Number of events for which the user or sentinel has been notified. */ -static int update_tick; +static EMACS_INT update_tick; /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */ @@ -228,13 +228,11 @@ static int update_tick; #endif #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING) -#ifdef EMACS_HAS_USECS #define ADAPTIVE_READ_BUFFERING #endif -#endif #ifdef ADAPTIVE_READ_BUFFERING -#define READ_OUTPUT_DELAY_INCREMENT 10000 +#define READ_OUTPUT_DELAY_INCREMENT (EMACS_TIME_RESOLUTION / 100) #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5) #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7) @@ -251,7 +249,6 @@ static int process_output_skip; #define process_output_delay_count 0 #endif -static Lisp_Object Fget_process (Lisp_Object); static void create_process (Lisp_Object, char **, Lisp_Object); #ifdef SIGIO static int keyboard_bit_set (SELECT_TYPE *); @@ -355,7 +352,7 @@ static struct fd_callback_data void add_read_fd (int fd, fd_callback func, void *data) { - xassert (fd < MAXDESC); + eassert (fd < MAXDESC); add_keyboard_wait_descriptor (fd); fd_callback_info[fd].func = func; @@ -368,7 +365,7 @@ add_read_fd (int fd, fd_callback func, void *data) void delete_read_fd (int fd) { - xassert (fd < MAXDESC); + eassert (fd < MAXDESC); delete_keyboard_wait_descriptor (fd); fd_callback_info[fd].condition &= ~FOR_READ; @@ -385,7 +382,7 @@ delete_read_fd (int fd) void add_write_fd (int fd, fd_callback func, void *data) { - xassert (fd < MAXDESC); + eassert (fd < MAXDESC); FD_SET (fd, &write_mask); if (fd > max_input_desc) max_input_desc = fd; @@ -402,7 +399,7 @@ delete_write_fd (int fd) { int lim = max_input_desc; - xassert (fd < MAXDESC); + eassert (fd < MAXDESC); FD_CLR (fd, &write_mask); fd_callback_info[fd].condition &= ~FOR_WRITE; if (fd_callback_info[fd].condition == 0) @@ -627,34 +624,18 @@ make_process (Lisp_Object name) printmax_t i; p = allocate_process (); - - p->infd = -1; - p->outfd = -1; - p->tick = 0; - p->update_tick = 0; - p->pid = 0; - p->pty_flag = 0; - p->raw_status_new = 0; + /* Initialize Lisp data. Note that allocate_process initializes all + Lisp data to nil, so do it only for slots which should not be nil. */ p->status = Qrun; p->mark = Fmake_marker (); - p->kill_without_query = 0; -#ifdef ADAPTIVE_READ_BUFFERING - p->adaptive_read_buffering = 0; - p->read_output_delay = 0; - p->read_output_skip = 0; -#endif + /* Initialize non-Lisp data. Note that allocate_process zeroes out all + non-Lisp data, so do it only for slots which should not be zero. */ + p->infd = -1; + p->outfd = -1; #ifdef HAVE_GNUTLS p->gnutls_initstage = GNUTLS_STAGE_EMPTY; - /* Default log level. */ - p->gnutls_log_level = 0; - /* GnuTLS handshakes attempted for this connection. */ - p->gnutls_handshakes_tried = 0; - p->gnutls_p = 0; - p->gnutls_state = NULL; - p->gnutls_x509_cred = NULL; - p->gnutls_anon_cred = NULL; #endif /* If name is already in use, modify it until it is unused. */ @@ -774,9 +755,7 @@ nil, indicating the current buffer's process. */) { #ifdef SIGCHLD Lisp_Object symbol; - /* Assignment to EMACS_INT stops GCC whining about limited range - of data type. */ - EMACS_INT pid = p->pid; + pid_t pid = p->pid; /* No problem storing the pid here, as it is still in Vprocess_alist. */ deleted_pid_list = Fcons (make_fixnum_or_float (pid), @@ -873,9 +852,7 @@ This is the pid of the external process which PROCESS uses or talks to. For a network connection, this value is nil. */) (register Lisp_Object process) { - /* Assignment to EMACS_INT stops GCC whining about limited range of - data type. */ - EMACS_INT pid; + pid_t pid; CHECK_PROCESS (process); pid = XPROCESS (process)->pid; @@ -1050,8 +1027,8 @@ DEFUN ("set-process-window-size", Fset_process_window_size, (register Lisp_Object process, Lisp_Object height, Lisp_Object width) { CHECK_PROCESS (process); - CHECK_NATNUM (height); - CHECK_NATNUM (width); + CHECK_RANGED_INTEGER (height, 0, INT_MAX); + CHECK_RANGED_INTEGER (width, 0, INT_MAX); if (XPROCESS (process)->infd < 0 || set_window_size (XPROCESS (process)->infd, @@ -1111,10 +1088,6 @@ DEFUN ("process-query-on-exit-flag", return (XPROCESS (process)->kill_without_query ? Qnil : Qt); } -#ifdef DATAGRAM_SOCKETS -static Lisp_Object Fprocess_datagram_address (Lisp_Object); -#endif - DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, 1, 2, 0, doc: /* Return the contact info of PROCESS; t for a real child. @@ -1214,7 +1187,7 @@ Returns nil if format of ADDRESS is invalid. */) if (VECTORP (address)) /* AF_INET or AF_INET6 */ { register struct Lisp_Vector *p = XVECTOR (address); - EMACS_INT size = p->header.size; + ptrdiff_t size = p->header.size; Lisp_Object args[10]; int nargs, i; @@ -1243,14 +1216,12 @@ Returns nil if format of ADDRESS is invalid. */) for (i = 0; i < nargs; i++) { - EMACS_INT element = XINT (p->contents[i]); - - if (element < 0 || element > 65535) + if (! RANGED_INTEGERP (0, p->contents[i], 65535)) return Qnil; if (nargs <= 5 /* IPv4 */ && i < 4 /* host, not port */ - && element > 255) + && XINT (p->contents[i]) > 255) return Qnil; args[i+1] = p->contents[i]; @@ -1305,7 +1276,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) Lisp_Object buffer, name, program, proc, current_dir, tem; register unsigned char **new_argv; ptrdiff_t i; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); buffer = args[1]; if (!NILP (buffer)) @@ -1394,7 +1365,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) val = Vcoding_system_for_read; if (NILP (val)) { - args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2); + args2 = alloca ((nargs + 1) * sizeof *args2); args2[0] = Qstart_process; for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; GCPRO2 (proc, current_dir); @@ -1413,7 +1384,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) { if (EQ (coding_systems, Qt)) { - args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2); + args2 = alloca ((nargs + 1) * sizeof *args2); args2[0] = Qstart_process; for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; GCPRO2 (proc, current_dir); @@ -1507,7 +1478,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) /* Now that everything is encoded we can collect the strings into NEW_ARGV. */ - new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *)); + new_argv = alloca ((nargs - 1) * sizeof *new_argv); new_argv[nargs - 2] = 0; for (i = nargs - 2; i-- != 0; ) @@ -2115,7 +2086,8 @@ get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp) return sizeof (struct sockaddr_un); } #endif - else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address))) + else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address)) + && VECTORP (XCDR (address))) { struct sockaddr *sa; *familyp = XINT (XCAR (address)); @@ -2138,6 +2110,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int register struct Lisp_Vector *p; register unsigned char *cp = NULL; register int i; + EMACS_INT hostport; memset (sa, 0, len); @@ -2148,8 +2121,8 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int { struct sockaddr_in *sin = (struct sockaddr_in *) sa; len = sizeof (sin->sin_addr) + 1; - i = XINT (p->contents[--len]); - sin->sin_port = htons (i); + hostport = XINT (p->contents[--len]); + sin->sin_port = htons (hostport); cp = (unsigned char *)&sin->sin_addr; sa->sa_family = family; } @@ -2159,8 +2132,8 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa; uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr; len = sizeof (sin6->sin6_addr) + 1; - i = XINT (p->contents[--len]); - sin6->sin6_port = htons (i); + hostport = XINT (p->contents[--len]); + sin6->sin6_port = htons (hostport); for (i = 0; i < len; i++) if (INTEGERP (p->contents[i])) { @@ -2315,7 +2288,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val) case SOPT_INT: { int optval; - if (INTEGERP (val)) + if (TYPE_RANGED_INTEGERP (int, val)) optval = XINT (val); else error ("Bad option value for %s", name); @@ -2354,7 +2327,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val) linger.l_onoff = 1; linger.l_linger = 0; - if (INTEGERP (val)) + if (TYPE_RANGED_INTEGERP (int, val)) linger.l_linger = XINT (val); else linger.l_onoff = NILP (val) ? 0 : 1; @@ -2593,7 +2566,7 @@ usage: (make-serial-process &rest ARGS) */) struct gcpro gcpro1; Lisp_Object name, buffer; Lisp_Object tem, val; - int specpdl_count = -1; + ptrdiff_t specpdl_count = -1; if (nargs == 0) return Qnil; @@ -2893,8 +2866,8 @@ usage: (make-network-process &rest ARGS) */) int xerrno = 0; int s = -1, outch, inch; struct gcpro gcpro1; - int count = SPECPDL_INDEX (); - int count1; + ptrdiff_t count = SPECPDL_INDEX (); + ptrdiff_t count1; Lisp_Object QCaddress; /* one of QClocal or QCremote */ Lisp_Object tem; Lisp_Object name, buffer, host, service, address; @@ -2941,7 +2914,7 @@ usage: (make-network-process &rest ARGS) */) error ("Network servers not supported"); #else is_server = 1; - if (INTEGERP (tem)) + if (TYPE_RANGED_INTEGERP (int, tem)) backlog = XINT (tem); #endif } @@ -3007,7 +2980,7 @@ usage: (make-network-process &rest ARGS) */) #endif else if (EQ (tem, Qipv4)) family = AF_INET; - else if (INTEGERP (tem)) + else if (TYPE_RANGED_INTEGERP (int, tem)) family = XINT (tem); else error ("Unknown address family"); @@ -3294,7 +3267,7 @@ usage: (make-network-process &rest ARGS) */) { /* Unlike most other syscalls connect() cannot be called again. (That would return EALREADY.) The proper way to - wait for completion is select(). */ + wait for completion is pselect(). */ int sc; socklen_t len; SELECT_TYPE fdset; @@ -3302,8 +3275,7 @@ usage: (make-network-process &rest ARGS) */) FD_ZERO (&fdset); FD_SET (s, &fdset); QUIT; - sc = select (s + 1, (SELECT_TYPE *)0, &fdset, (SELECT_TYPE *)0, - (EMACS_TIME *)0); + sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL); if (sc == -1) { if (errno == EINTR) @@ -3344,7 +3316,7 @@ usage: (make-network-process &rest ARGS) */) { if (datagram_address[s].sa) abort (); - datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen); + datagram_address[s].sa = xmalloc (lres->ai_addrlen); datagram_address[s].len = lres->ai_addrlen; if (is_server) { @@ -3964,7 +3936,8 @@ If JUST-THIS-ONE is an integer, don't run any timers either. Return non-nil if we received any output before the timeout expired. */) (register Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec, Lisp_Object just_this_one) { - int secs, usecs = 0; + intmax_t secs; + int nsecs; if (! NILP (process)) CHECK_PROCESS (process); @@ -3983,27 +3956,36 @@ Return non-nil if we received any output before the timeout expired. */) } } + secs = 0; + nsecs = -1; + if (!NILP (seconds)) { if (INTEGERP (seconds)) - secs = XINT (seconds); + { + if (0 < XINT (seconds)) + { + secs = XINT (seconds); + nsecs = 0; + } + } else if (FLOATP (seconds)) { - double timeout = XFLOAT_DATA (seconds); - secs = (int) timeout; - usecs = (int) ((timeout - (double) secs) * 1000000); + if (0 < XFLOAT_DATA (seconds)) + { + EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (seconds)); + secs = min (EMACS_SECS (t), WAIT_READING_MAX); + nsecs = EMACS_NSECS (t); + } } else wrong_type_argument (Qnumberp, seconds); - - if (secs < 0 || (secs == 0 && usecs == 0)) - secs = -1, usecs = 0; } - else - secs = NILP (process) ? -1 : 0; + else if (! NILP (process)) + nsecs = 0; return - (wait_reading_process_output (secs, usecs, 0, 0, + (wait_reading_process_output (secs, nsecs, 0, 0, Qnil, !NILP (process) ? XPROCESS (process) : NULL, NILP (just_this_one) ? 0 : @@ -4244,34 +4226,19 @@ wait_reading_process_output_1 (void) { } -/* Use a wrapper around select to work around a bug in gdb 5.3. - Normally, the wrapper is optimized away by inlining. - - If emacs is stopped inside select, the gdb backtrace doesn't - show the function which called select, so it is practically - impossible to step through wait_reading_process_output. */ - -#ifndef select -static inline int -select_wrapper (int n, fd_set *rfd, fd_set *wfd, fd_set *xfd, struct timeval *tmo) -{ - return select (n, rfd, wfd, xfd, tmo); -} -#define select select_wrapper -#endif - /* Read and dispose of subprocess output while waiting for timeout to elapse and/or keyboard input to be available. TIME_LIMIT is: - timeout in seconds, or - zero for no limit, or - -1 means gobble data immediately available but don't wait for any. + timeout in seconds + If negative, gobble data immediately available but don't wait for any. - MICROSECS is: - an additional duration to wait, measured in microseconds. - If this is nonzero and time_limit is 0, then the timeout - consists of MICROSECS only. + NSECS is: + an additional duration to wait, measured in nanoseconds + If TIME_LIMIT is zero, then: + If NSECS == 0, there is no limit. + If NSECS > 0, the timeout consists of NSECS only. + If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative. READ_KBD is a lisp value: 0 to ignore keyboard input, or @@ -4298,7 +4265,7 @@ select_wrapper (int n, fd_set *rfd, fd_set *wfd, fd_set *xfd, struct timeval *tm Otherwise, return true if we received input from any process. */ int -wait_reading_process_output (int time_limit, int microsecs, int read_kbd, +wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, int do_display, Lisp_Object wait_for_cell, struct Lisp_Process *wait_proc, int just_wait_proc) @@ -4313,12 +4280,12 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, EMACS_TIME timeout, end_time; int wait_channel = -1; int got_some_input = 0; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); FD_ZERO (&Available); FD_ZERO (&Writeok); - if (time_limit == 0 && microsecs == 0 && wait_proc && !NILP (Vinhibit_quit) + if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit) && !(CONSP (wait_proc->status) && EQ (XCAR (wait_proc->status), Qexit))) message ("Blocking call to accept-process-output with quit inhibited!!"); @@ -4330,12 +4297,20 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, make_number (waiting_for_user_input_p)); waiting_for_user_input_p = read_kbd; + if (time_limit < 0) + { + time_limit = 0; + nsecs = -1; + } + else if (TYPE_MAXIMUM (time_t) < time_limit) + time_limit = TYPE_MAXIMUM (time_t); + /* Since we may need to wait several times, compute the absolute time to return at. */ - if (time_limit || microsecs) + if (time_limit || 0 < nsecs) { EMACS_GET_TIME (end_time); - EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); + EMACS_SET_SECS_NSECS (timeout, time_limit, nsecs); EMACS_ADD_TIME (end_time, end_time, timeout); } @@ -4359,20 +4334,20 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, /* Compute time from now till when time limit is up */ /* Exit if already run out */ - if (time_limit == -1) + if (nsecs < 0) { - /* -1 specified for timeout means + /* A negative timeout means gobble output available now but don't wait at all. */ EMACS_SET_SECS_USECS (timeout, 0, 0); } - else if (time_limit || microsecs) + else if (time_limit || 0 < nsecs) { EMACS_GET_TIME (timeout); - EMACS_SUB_TIME (timeout, end_time, timeout); - if (EMACS_TIME_NEG_P (timeout)) + if (EMACS_TIME_LE (end_time, timeout)) break; + EMACS_SUB_TIME (timeout, end_time, timeout); } else { @@ -4418,21 +4393,22 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, && requeued_events_pending_p ()) break; - if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1) + /* A negative timeout means do not wait at all. */ + if (0 <= nsecs) { - EMACS_TIME difference; - EMACS_SUB_TIME (difference, timer_delay, timeout); - if (EMACS_TIME_NEG_P (difference)) + if (EMACS_TIME_VALID_P (timer_delay)) { - timeout = timer_delay; - timeout_reduced_for_timers = 1; + if (EMACS_TIME_LT (timer_delay, timeout)) + { + timeout = timer_delay; + timeout_reduced_for_timers = 1; + } + } + else + { + /* This is so a breakpoint can be put here. */ + wait_reading_process_output_1 (); } - } - /* If time_limit is -1, we are not going to wait at all. */ - else if (time_limit != -1) - { - /* This is so a breakpoint can be put here. */ - wait_reading_process_output_1 (); } } @@ -4461,14 +4437,14 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, Ctemp = write_mask; EMACS_SET_SECS_USECS (timeout, 0, 0); - if ((select (max (max_process_desc, max_input_desc) + 1, - &Atemp, + if ((pselect (max (max_process_desc, max_input_desc) + 1, + &Atemp, #ifdef NON_BLOCKING_CONNECT - (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), + (num_pending_connects > 0 ? &Ctemp : NULL), #else - (SELECT_TYPE *)0, + NULL, #endif - (SELECT_TYPE *)0, &timeout) + NULL, &timeout, NULL) <= 0)) { /* It's okay for us to do this and then continue with @@ -4591,9 +4567,9 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, Vprocess_adaptive_read_buffering is nil. */ if (process_output_skip && check_delay > 0) { - int usecs = EMACS_USECS (timeout); - if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX) - usecs = READ_OUTPUT_DELAY_MAX; + int nsecs = EMACS_NSECS (timeout); + if (EMACS_SECS (timeout) > 0 || nsecs > READ_OUTPUT_DELAY_MAX) + nsecs = READ_OUTPUT_DELAY_MAX; for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++) { proc = chan_process[channel]; @@ -4608,11 +4584,11 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, continue; FD_CLR (channel, &Available); XPROCESS (proc)->read_output_skip = 0; - if (XPROCESS (proc)->read_output_delay < usecs) - usecs = XPROCESS (proc)->read_output_delay; + if (XPROCESS (proc)->read_output_delay < nsecs) + nsecs = XPROCESS (proc)->read_output_delay; } } - EMACS_SET_SECS_USECS (timeout, 0, usecs); + EMACS_SET_SECS_NSECS (timeout, 0, nsecs); process_output_skip = 0; } #endif @@ -4621,12 +4597,12 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, #elif defined (HAVE_NS) nfds = ns_select #else - nfds = select + nfds = pselect #endif (max (max_process_desc, max_input_desc) + 1, &Available, (check_write ? &Writeok : (SELECT_TYPE *)0), - (SELECT_TYPE *)0, &timeout); + NULL, &timeout, NULL); #ifdef HAVE_GNUTLS /* GnuTLS buffers data internally. In lowat mode it leaves @@ -4684,8 +4660,8 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, /* If we woke up due to SIGWINCH, actually change size now. */ do_pending_window_change (0); - if (time_limit && nfds == 0 && ! timeout_reduced_for_timers) - /* We wanted the full specified time, so return now. */ + if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers) + /* We waited the full specified time, so return now. */ break; if (nfds < 0) { @@ -4836,7 +4812,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, if (wait_channel == channel) { wait_channel = -1; - time_limit = -1; + nsecs = -1; got_some_input = 1; } proc = chan_process[channel]; @@ -5054,14 +5030,14 @@ read_process_output (Lisp_Object proc, register int channel) char *chars; register Lisp_Object outstream; register struct Lisp_Process *p = XPROCESS (proc); - register EMACS_INT opoint; + register ptrdiff_t opoint; struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = p->decoding_carryover; int readmax = 4096; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object odeactivate; - chars = (char *) alloca (carryover + readmax); + chars = alloca (carryover + readmax); if (carryover) /* See the comment above. */ memcpy (chars, SDATA (p->decoding_buf), carryover); @@ -5253,10 +5229,10 @@ read_process_output (Lisp_Object proc, register int channel) else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name))) { Lisp_Object old_read_only; - EMACS_INT old_begv, old_zv; - EMACS_INT old_begv_byte, old_zv_byte; - EMACS_INT before, before_byte; - EMACS_INT opoint_byte; + ptrdiff_t old_begv, old_zv; + ptrdiff_t old_begv_byte, old_zv_byte; + ptrdiff_t before, before_byte; + ptrdiff_t opoint_byte; Lisp_Object text; struct buffer *b; @@ -5374,7 +5350,7 @@ static jmp_buf send_process_frame; static Lisp_Object process_sent_to; #ifndef FORWARD_SIGNAL_TO_MAIN_THREAD -static void send_process_trap (int) NO_RETURN; +static _Noreturn void send_process_trap (int); #endif static void @@ -5385,6 +5361,78 @@ send_process_trap (int ignore) longjmp (send_process_frame, 1); } +/* In send_process, when a write fails temporarily, + wait_reading_process_output is called. It may execute user code, + e.g. timers, that attempts to write new data to the same process. + We must ensure that data is sent in the right order, and not + interspersed half-completed with other writes (Bug#10815). This is + handled by the write_queue element of struct process. It is a list + with each entry having the form + + (string . (offset . length)) + + where STRING is a lisp string, OFFSET is the offset into the + string's byte sequence from which we should begin to send, and + LENGTH is the number of bytes left to send. */ + +/* Create a new entry in write_queue. + INPUT_OBJ should be a buffer, string Qt, or Qnil. + BUF is a pointer to the string sequence of the input_obj or a C + string in case of Qt or Qnil. */ + +static void +write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj, + const char *buf, ptrdiff_t len, int front) +{ + ptrdiff_t offset; + Lisp_Object entry, obj; + + if (STRINGP (input_obj)) + { + offset = buf - SSDATA (input_obj); + obj = input_obj; + } + else + { + offset = 0; + obj = make_unibyte_string (buf, len); + } + + entry = Fcons (obj, Fcons (make_number (offset), make_number (len))); + + if (front) + p->write_queue = Fcons (entry, p->write_queue); + else + p->write_queue = nconc2 (p->write_queue, Fcons (entry, Qnil)); +} + +/* Remove the first element in the write_queue of process P, put its + contents in OBJ, BUF and LEN, and return non-zero. If the + write_queue is empty, return zero. */ + +static int +write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj, + const char **buf, ptrdiff_t *len) +{ + Lisp_Object entry, offset_length; + ptrdiff_t offset; + + if (NILP (p->write_queue)) + return 0; + + entry = XCAR (p->write_queue); + p->write_queue = XCDR (p->write_queue); + + *obj = XCAR (entry); + offset_length = XCDR (entry); + + *len = XINT (XCDR (offset_length)); + offset = XINT (XCAR (offset_length)); + *buf = SSDATA (*obj) + offset; + + return 1; +} + /* Send some data to process PROC. BUF is the beginning of the data; LEN is the number of characters. OBJECT is the Lisp object that the data comes from. If OBJECT is @@ -5397,17 +5445,14 @@ send_process_trap (int ignore) static void send_process (volatile Lisp_Object proc, const char *volatile buf, - volatile EMACS_INT len, volatile Lisp_Object object) + volatile ptrdiff_t len, volatile Lisp_Object object) { /* Use volatile to protect variables from being clobbered by longjmp. */ struct Lisp_Process *p = XPROCESS (proc); ssize_t rv; struct coding_system *coding; - struct gcpro gcpro1; void (*volatile old_sigpipe) (int); - GCPRO1 (object); - if (p->raw_status_new) update_status (p); if (! EQ (p->status, Qrun)) @@ -5468,8 +5513,8 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, coding->dst_object = Qt; if (BUFFERP (object)) { - EMACS_INT from_byte, from, to; - EMACS_INT save_pt, save_pt_byte; + ptrdiff_t from_byte, from, to; + ptrdiff_t save_pt, save_pt_byte; struct buffer *cur = current_buffer; set_buffer_internal (XBUFFER (object)); @@ -5519,22 +5564,37 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, if (!setjmp (send_process_frame)) { p = XPROCESS (proc); /* Repair any setjmp clobbering. */ - process_sent_to = proc; - while (len > 0) + + /* If there is already data in the write_queue, put the new data + in the back of queue. Otherwise, ignore it. */ + if (!NILP (p->write_queue)) + write_queue_push (p, object, buf, len, 0); + + do /* while !NILP (p->write_queue) */ { - EMACS_INT this = len; + ptrdiff_t cur_len = -1; + const char *cur_buf; + Lisp_Object cur_object; - /* Send this batch, using one or more write calls. */ - while (this > 0) + /* If write_queue is empty, ignore it. */ + if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len)) { - EMACS_INT written = 0; + cur_len = len; + cur_buf = buf; + cur_object = object; + } + + while (cur_len > 0) + { + /* Send this batch, using one or more write calls. */ + ptrdiff_t written = 0; int outfd = p->outfd; old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap); #ifdef DATAGRAM_SOCKETS if (DATAGRAM_CHAN_P (outfd)) { - rv = sendto (outfd, buf, this, + rv = sendto (outfd, cur_buf, cur_len, 0, datagram_address[outfd].sa, datagram_address[outfd].len); if (0 <= rv) @@ -5551,10 +5611,10 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, { #ifdef HAVE_GNUTLS if (p->gnutls_p) - written = emacs_gnutls_write (p, buf, this); + written = emacs_gnutls_write (p, cur_buf, cur_len); else #endif - written = emacs_write (outfd, buf, this); + written = emacs_write (outfd, cur_buf, cur_len); rv = (written ? 0 : -1); #ifdef ADAPTIVE_READ_BUFFERING if (p->read_output_delay > 0 @@ -5582,8 +5642,6 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, that may allow the program to finish doing output and read more. */ { - EMACS_INT offset = 0; - #ifdef BROKEN_PTY_READ_AFTER_EAGAIN /* A gross hack to work around a bug in FreeBSD. In the following sequence, read(2) returns @@ -5609,35 +5667,22 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, } #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ - /* Running filters might relocate buffers or strings. - Arrange to relocate BUF. */ - if (BUFFERP (object)) - offset = BUF_PTR_BYTE_POS (XBUFFER (object), - (unsigned char *) buf); - else if (STRINGP (object)) - offset = buf - SSDATA (object); - -#ifdef EMACS_HAS_USECS - wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0); -#else - wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0); -#endif - - if (BUFFERP (object)) - buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object), - offset); - else if (STRINGP (object)) - buf = offset + SSDATA (object); + /* Put what we should have written in wait_queue. */ + write_queue_push (p, cur_object, cur_buf, cur_len, 1); + wait_reading_process_output (0, 20 * 1000 * 1000, + 0, 0, Qnil, NULL, 0); + /* Reread queue, to see what is left. */ + break; } else /* This is a real error. */ report_file_error ("writing to process", Fcons (proc, Qnil)); } - buf += written; - len -= written; - this -= written; + cur_buf += written; + cur_len -= written; } } + while (!NILP (p->write_queue)); } else { @@ -5650,8 +5695,6 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, deactivate_process (proc); error ("SIGPIPE raised on process %s; closed it", SDATA (p->name)); } - - UNGCPRO; } DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, @@ -5666,7 +5709,7 @@ Output from processes can arrive in between bunches. */) (Lisp_Object process, Lisp_Object start, Lisp_Object end) { Lisp_Object proc; - EMACS_INT start1, end1; + ptrdiff_t start1, end1; proc = get_process (process); validate_region (&start, &end); @@ -5702,10 +5745,10 @@ Output from processes can arrive in between bunches. */) /* Return the foreground process group for the tty/pty that the process P uses. */ -static int +static pid_t emacs_get_tty_pgrp (struct Lisp_Process *p) { - int gid = -1; + pid_t gid = -1; #ifdef TIOCGPGRP if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) @@ -5735,7 +5778,7 @@ return t unconditionally. */) { /* Initialize in case ioctl doesn't exist or gives an error, in a way that will cause returning t. */ - int gid; + pid_t gid; Lisp_Object proc; struct Lisp_Process *p; @@ -5776,7 +5819,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group, { Lisp_Object proc; register struct Lisp_Process *p; - int gid; + pid_t gid; int no_pgrp = 0; proc = get_process (process); @@ -6030,48 +6073,40 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) { pid_t pid; - if (INTEGERP (process)) - { - pid = XINT (process); - goto got_it; - } - - if (FLOATP (process)) - { - pid = (pid_t) XFLOAT_DATA (process); - goto got_it; - } - if (STRINGP (process)) { - Lisp_Object tem; - if (tem = Fget_process (process), NILP (tem)) + Lisp_Object tem = Fget_process (process); + if (NILP (tem)) { - pid = XINT (Fstring_to_number (process, make_number (10))); - if (pid > 0) - goto got_it; + Lisp_Object process_number = + string_to_number (SSDATA (process), 10, 1); + if (INTEGERP (process_number) || FLOATP (process_number)) + tem = process_number; } process = tem; } - else + else if (!NUMBERP (process)) process = get_process (process); if (NILP (process)) return process; - CHECK_PROCESS (process); - pid = XPROCESS (process)->pid; - if (pid <= 0) - error ("Cannot signal process %s", SDATA (XPROCESS (process)->name)); - - got_it: + if (NUMBERP (process)) + CONS_TO_INTEGER (process, pid_t, pid); + else + { + CHECK_PROCESS (process); + pid = XPROCESS (process)->pid; + if (pid <= 0) + error ("Cannot signal process %s", SDATA (XPROCESS (process)->name)); + } #define parse_signal(NAME, VALUE) \ else if (!xstrcasecmp (name, NAME)) \ XSETINT (sigcode, VALUE) if (INTEGERP (sigcode)) - ; + CHECK_TYPE_RANGED_INTEGER (int, sigcode); else { char *name; @@ -6251,7 +6286,7 @@ process has been transmitted to the serial port. */) if (!proc_encode_coding_system[new_outfd]) proc_encode_coding_system[new_outfd] - = (struct coding_system *) xmalloc (sizeof (struct coding_system)); + = xmalloc (sizeof (struct coding_system)); memcpy (proc_encode_coding_system[new_outfd], proc_encode_coding_system[old_outfd], sizeof (struct coding_system)); @@ -6334,8 +6369,8 @@ sigchld_handler (int signo) for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object xpid = XCAR (tail); - if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid)) - || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid))) + if ((INTEGERP (xpid) && pid == XINT (xpid)) + || (FLOATP (xpid) && pid == XFLOAT_DATA (xpid))) { XSETCAR (tail, Qnil); goto sigchld_end_of_loop; @@ -6451,7 +6486,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) { Lisp_Object sentinel, odeactivate; register struct Lisp_Process *p = XPROCESS (proc); - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); int outer_running_asynch_code = running_asynch_code; int waiting = waiting_for_user_input_p; @@ -6610,8 +6645,8 @@ status_notify (struct Lisp_Process *deleting_process) { Lisp_Object tem; struct buffer *old = current_buffer; - EMACS_INT opoint, opoint_byte; - EMACS_INT before, before_byte; + ptrdiff_t opoint, opoint_byte; + ptrdiff_t before, before_byte; /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ @@ -6768,19 +6803,25 @@ keyboard_bit_set (fd_set *mask) /* Defined on msdos.c. */ extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, - EMACS_TIME *); + EMACS_TIME *, void *); /* Implementation of wait_reading_process_output, assuming that there are no subprocesses. Used only by the MS-DOS build. Wait for timeout to elapse and/or keyboard input to be available. - time_limit is: - timeout in seconds, or - zero for no limit, or - -1 means gobble data immediately available but don't wait for any. + TIME_LIMIT is: + timeout in seconds + If negative, gobble data immediately available but don't wait for any. + + NSECS is: + an additional duration to wait, measured in nanoseconds + If TIME_LIMIT is zero, then: + If NSECS == 0, there is no limit. + If NSECS > 0, the timeout consists of NSECS only. + If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative. - read_kbd is a Lisp_Object: + READ_KBD is a Lisp_Object: 0 to ignore keyboard input, or 1 to return when input is available, or -1 means caller will actually read the input, so don't throw to @@ -6789,13 +6830,13 @@ extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, see full version for other parameters. We know that wait_proc will always be NULL, since `subprocesses' isn't defined. - do_display != 0 means redisplay should be done to show subprocess + DO_DISPLAY != 0 means redisplay should be done to show subprocess output that arrives. Return true if we received input from any process. */ int -wait_reading_process_output (int time_limit, int microsecs, int read_kbd, +wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, int do_display, Lisp_Object wait_for_cell, struct Lisp_Process *wait_proc, int just_wait_proc) @@ -6805,11 +6846,19 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, SELECT_TYPE waitchannels; int xerrno; + if (time_limit < 0) + { + time_limit = 0; + nsecs = -1; + } + else if (TYPE_MAXIMUM (time_t) < time_limit) + time_limit = TYPE_MAXIMUM (time_t); + /* What does time_limit really mean? */ - if (time_limit || microsecs) + if (time_limit || 0 < nsecs) { EMACS_GET_TIME (end_time); - EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); + EMACS_SET_SECS_NSECS (timeout, time_limit, nsecs); EMACS_ADD_TIME (end_time, end_time, timeout); } @@ -6835,20 +6884,20 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, /* Compute time from now till when time limit is up */ /* Exit if already run out */ - if (time_limit == -1) + if (nsecs < 0) { - /* -1 specified for timeout means + /* A negative timeout means gobble output available now but don't wait at all. */ EMACS_SET_SECS_USECS (timeout, 0, 0); } - else if (time_limit || microsecs) + else if (time_limit || 0 < nsecs) { EMACS_GET_TIME (timeout); - EMACS_SUB_TIME (timeout, end_time, timeout); - if (EMACS_TIME_NEG_P (timeout)) + if (EMACS_TIME_LE (end_time, timeout)) break; + EMACS_SUB_TIME (timeout, end_time, timeout); } else { @@ -6881,11 +6930,9 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, && requeued_events_pending_p ()) break; - if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1) + if (EMACS_TIME_VALID_P (timer_delay) && 0 <= nsecs) { - EMACS_TIME difference; - EMACS_SUB_TIME (difference, timer_delay, timeout); - if (EMACS_TIME_NEG_P (difference)) + if (EMACS_TIME_LT (timer_delay, timeout)) { timeout = timer_delay; timeout_reduced_for_timers = 1; @@ -6921,8 +6968,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, FD_ZERO (&waitchannels); } else - nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0, - &timeout); + nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL); xerrno = errno; @@ -6932,7 +6978,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, /* If we woke up due to SIGWINCH, actually change size now. */ do_pending_window_change (0); - if (time_limit && nfds == 0 && ! timeout_reduced_for_timers) + if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers) /* We waited the full specified time, so return now. */ break; @@ -7037,8 +7083,7 @@ setup_process_coding_systems (Lisp_Object process) return; if (!proc_decode_coding_system[inch]) - proc_decode_coding_system[inch] - = (struct coding_system *) xmalloc (sizeof (struct coding_system)); + proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system)); coding_system = p->decode_coding_system; if (! NILP (p->filter)) ; @@ -7050,8 +7095,7 @@ setup_process_coding_systems (Lisp_Object process) setup_coding_system (coding_system, proc_decode_coding_system[inch]); if (!proc_encode_coding_system[outch]) - proc_encode_coding_system[outch] - = (struct coding_system *) xmalloc (sizeof (struct coding_system)); + proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system)); setup_coding_system (p->encode_coding_system, proc_encode_coding_system[outch]); #endif @@ -7235,19 +7279,20 @@ integer or floating point values. majflt -- number of major page faults (number) cminflt -- cumulative number of minor page faults (number) cmajflt -- cumulative number of major page faults (number) - utime -- user time used by the process, in the (HIGH LOW USEC) format - stime -- system time used by the process, in the (HIGH LOW USEC) format - time -- sum of utime and stime, in the (HIGH LOW USEC) format - cutime -- user time used by the process and its children, (HIGH LOW USEC) - cstime -- system time used by the process and its children, (HIGH LOW USEC) - ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format + utime -- user time used by the process, in (current-time) format, + which is a list of integers (HIGH LOW USEC PSEC) + stime -- system time used by the process (current-time) + time -- sum of utime and stime (current-time) + cutime -- user time used by the process and its children (current-time) + cstime -- system time used by the process and its children (current-time) + ctime -- sum of cutime and cstime (current-time) pri -- priority of the process (number) nice -- nice value of the process (number) thcount -- process thread count (number) - start -- time the process started, in the (HIGH LOW USEC) format + start -- time the process started (current-time) vsize -- virtual memory size of the process in KB's (number) rss -- resident set size of the process in KB's (number) - etime -- elapsed time the process is running, in (HIGH LOW USEC) format + etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format pcpu -- percents of CPU time used by the process (floating-point number) pmem -- percents of total physical memory used by process's resident set (floating-point number)