/* Asynchronous subprocess control for GNU Emacs.
Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
- 2001, 2002, 2003 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#undef DATAGRAM_SOCKETS
#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_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
+#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
+
+/* Number of processes which might be delayed. */
+
+static int process_output_delay_count;
+
+/* Non-zero if any process has non-nil process_output_skip. */
+
+static int process_output_skip;
+
+/* Non-nil means to delay reading process output to improve buffering.
+ A value of t means that delay is reset after each send, any other
+ non-nil value does not reset the delay. */
+static Lisp_Object Vprocess_adaptive_read_buffering;
+#else
+#define process_output_delay_count 0
+#endif
+
#include "sysselect.h"
p->status = Qrun;
p->mark = Fmake_marker ();
+#ifdef ADAPTIVE_READ_BUFFERING
+ p->adaptive_read_buffering = Qnil;
+ XSETFASTINT (p->read_output_delay, 0);
+ p->read_output_skip = Qnil;
+#endif
+
/* If name is already in use, modify it until it is unused. */
name1 = name;
(process, sentinel)
register Lisp_Object process, sentinel;
{
+ struct Lisp_Process *p;
+
CHECK_PROCESS (process);
- XPROCESS (process)->sentinel = sentinel;
+ p = XPROCESS (process);
+
+ p->sentinel = sentinel;
+ if (NETCONN1_P (p))
+ p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
return sentinel;
}
= buffer_defaults.enable_multibyte_characters;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
+#ifdef ADAPTIVE_READ_BUFFERING
+ XPROCESS (proc)->adaptive_read_buffering = Vprocess_adaptive_read_buffering;
+#endif
+
/* Make the process marker point into the process buffer (if any). */
if (!NILP (buffer))
set_marker_both (XPROCESS (proc)->mark, buffer,
/* The name of this option. Should be lowercase version of option
name without SO_ prefix. */
char *name;
- /* Length of name. */
- int nlen;
/* Option level SOL_... */
int optlevel;
/* Option number SO_... */
int optnum;
- enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype;
+ enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
+ enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
} socket_options[] =
{
#ifdef SO_BINDTODEVICE
- { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
+ { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
#endif
#ifdef SO_BROADCAST
- { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
+ { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_DONTROUTE
- { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
+ { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_KEEPALIVE
- { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
+ { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_LINGER
- { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
+ { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
#endif
#ifdef SO_OOBINLINE
- { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
+ { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_PRIORITY
- { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
+ { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
#endif
#ifdef SO_REUSEADDR
- { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
+ { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
#endif
- { 0, 0, 0, 0, SOPT_UNKNOWN }
+ { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
};
-/* Process list of socket options OPTS on socket S.
- Only check if options are supported is S < 0.
- If NO_ERROR is non-zero, continue silently if an option
- cannot be set.
+/* Set option OPT to value VAL on socket S.
- Each element specifies one option. An element is either a string
- "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
- or a symbol. */
+ Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
+ Signals an error if setting a known option fails.
+*/
static int
-set_socket_options (s, opts, no_error)
+set_socket_option (s, opt, val)
int s;
- Lisp_Object opts;
- int no_error;
+ Lisp_Object opt, val;
{
- if (!CONSP (opts))
- opts = Fcons (opts, Qnil);
+ char *name;
+ struct socket_options *sopt;
+ int ret = 0;
- while (CONSP (opts))
- {
- Lisp_Object opt;
- Lisp_Object val;
- char *name, *arg;
- struct socket_options *sopt;
- int ret = 0;
-
- opt = XCAR (opts);
- opts = XCDR (opts);
-
- name = 0;
- val = Qt;
- if (CONSP (opt))
- {
- val = XCDR (opt);
- opt = XCAR (opt);
- }
- if (STRINGP (opt))
- name = (char *) SDATA (opt);
- else if (SYMBOLP (opt))
- name = (char *) SDATA (SYMBOL_NAME (opt));
- else {
- error ("Mal-formed option list");
- return 0;
- }
+ CHECK_SYMBOL (opt);
- if (strncmp (name, "no", 2) == 0)
- {
- val = Qnil;
- name += 2;
- }
+ name = (char *) SDATA (SYMBOL_NAME (opt));
+ for (sopt = socket_options; sopt->name; sopt++)
+ if (strcmp (name, sopt->name) == 0)
+ break;
- arg = 0;
- for (sopt = socket_options; sopt->name; sopt++)
- if (strncmp (name, sopt->name, sopt->nlen) == 0)
- {
- if (name[sopt->nlen] == 0)
- break;
- if (name[sopt->nlen] == '=')
- {
- arg = name + sopt->nlen + 1;
- break;
- }
- }
+ switch (sopt->opttype)
+ {
+ case SOPT_BOOL:
+ {
+ int optval;
+ optval = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
- switch (sopt->opttype)
- {
- case SOPT_BOOL:
- {
- int optval;
- if (s < 0)
- return 1;
- if (arg)
- optval = (*arg == '0' || *arg == 'n') ? 0 : 1;
- else if (INTEGERP (val))
- optval = XINT (val) == 0 ? 0 : 1;
- else
- optval = NILP (val) ? 0 : 1;
- ret = setsockopt (s, sopt->optlevel, sopt->optnum,
- &optval, sizeof (optval));
- break;
- }
+ case SOPT_INT:
+ {
+ int optval;
+ if (INTEGERP (val))
+ optval = XINT (val);
+ else
+ error ("Bad option value for %s", name);
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
- case SOPT_INT:
- {
- int optval;
- if (arg)
- optval = atoi(arg);
- else if (INTEGERP (val))
- optval = XINT (val);
- else
- error ("Bad option argument for %s", name);
- if (s < 0)
- return 1;
- ret = setsockopt (s, sopt->optlevel, sopt->optnum,
- &optval, sizeof (optval));
- break;
- }
+#ifdef SO_BINDTODEVICE
+ case SOPT_IFNAME:
+ {
+ char devname[IFNAMSIZ+1];
- case SOPT_STR:
+ /* This is broken, at least in the Linux 2.4 kernel.
+ To unbind, the arg must be a zero integer, not the empty string.
+ This should work on all systems. KFS. 2003-09-23. */
+ bzero (devname, sizeof devname);
+ if (STRINGP (val))
{
- if (!arg)
- {
- if (NILP (val))
- arg = "";
- else if (STRINGP (val))
- arg = (char *) SDATA (val);
- else if (XSYMBOL (val))
- arg = (char *) SDATA (SYMBOL_NAME (val));
- else
- error ("Invalid argument to %s option", name);
- }
- ret = setsockopt (s, sopt->optlevel, sopt->optnum,
- arg, strlen (arg));
+ char *arg = (char *) SDATA (val);
+ int len = min (strlen (arg), IFNAMSIZ);
+ bcopy (arg, devname, len);
}
+ else if (!NILP (val))
+ error ("Bad option value for %s", name);
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ devname, IFNAMSIZ);
+ break;
+ }
+#endif
#ifdef SO_LINGER
- case SOPT_LINGER:
- {
- struct linger linger;
-
- linger.l_onoff = 1;
- linger.l_linger = 0;
-
- if (s < 0)
- return 1;
+ case SOPT_LINGER:
+ {
+ struct linger linger;
- if (arg)
- {
- if (*arg == 'n' || *arg == 't' || *arg == 'y')
- linger.l_onoff = (*arg == 'n') ? 0 : 1;
- else
- linger.l_linger = atoi(arg);
- }
- else if (INTEGERP (val))
- linger.l_linger = XINT (val);
- else
- linger.l_onoff = NILP (val) ? 0 : 1;
- ret = setsockopt (s, sopt->optlevel, sopt->optnum,
- &linger, sizeof (linger));
- break;
- }
+ linger.l_onoff = 1;
+ linger.l_linger = 0;
+ if (INTEGERP (val))
+ linger.l_linger = XINT (val);
+ else
+ linger.l_onoff = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &linger, sizeof (linger));
+ break;
+ }
#endif
- default:
- if (s < 0)
- return 0;
- if (no_error)
- continue;
- error ("Unsupported option: %s", name);
- }
- if (ret < 0 && ! no_error)
- report_file_error ("Cannot set network option: %s", opt);
+
+ default:
+ return 0;
}
- return 1;
+
+ if (ret < 0)
+ report_file_error ("Cannot set network option",
+ Fcons (opt, Fcons (val, Qnil)));
+ return (1 << sopt->optbit);
}
-DEFUN ("set-network-process-options",
- Fset_network_process_options, Sset_network_process_options,
- 1, MANY, 0,
- doc: /* Set one or more options for network process PROCESS.
-Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
-A boolean value is false if it either zero or nil, true otherwise.
-
-The following options are known. Consult the relevant system manual
-pages for more information.
-
-bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
-broadcast=BOOL -- Allow send and receive of datagram broadcasts.
-dontroute=BOOL -- Only send to directly connected hosts.
-keepalive=BOOL -- Send keep-alive messages on network stream.
-linger=BOOL or TIMEOUT -- Send queued messages before closing.
-oobinline=BOOL -- Place out-of-band data in receive data stream.
-priority=INT -- Set protocol defined priority for sent packets.
-reuseaddr=BOOL -- Allow reusing a recently used address.
-
-usage: (set-network-process-options PROCESS &rest OPTIONS) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
+
+DEFUN ("set-network-process-option",
+ Fset_network_process_option, Sset_network_process_option,
+ 3, 4, 0,
+ doc: /* For network process PROCESS set option OPTION to value VALUE.
+See `make-network-process' for a list of options and values.
+If optional fourth arg NO-ERROR is non-nil, don't signal an error if
+OPTION is not a supported option, return nil instead; otherwise return t. */)
+ (process, option, value, no_error)
+ Lisp_Object process, option, value;
+ Lisp_Object no_error;
{
- Lisp_Object process;
- Lisp_Object opts;
+ int s;
+ struct Lisp_Process *p;
- process = args[0];
CHECK_PROCESS (process);
- if (nargs > 1 && XINT (XPROCESS (process)->infd) >= 0)
+ p = XPROCESS (process);
+ if (!NETCONN1_P (p))
+ error ("Process is not a network process");
+
+ s = XINT (p->infd);
+ if (s < 0)
+ error ("Process is not running");
+
+ if (set_socket_option (s, option, value))
{
- opts = Flist (nargs, args);
- set_socket_options (XINT (XPROCESS (process)->infd), opts, 0);
+ p->childp = Fplist_put (p->childp, option, value);
+ return Qt;
}
- return process;
+
+ if (NILP (no_error))
+ error ("Unknown or unsupported option");
+
+ return Qnil;
}
+
\f
/* A version of request_sigio suitable for a record_unwind_protect. */
this format in portable code, as it may depend on implementation
defined constants, data sizes, and data structure alignment.
-:coding CODING -- CODING is coding system for this process.
-
-:options OPTIONS -- Set the specified options for the network process.
-See `set-network-process-options' for details.
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process. If CODING
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
+ENCODING is used for writing.
:nowait BOOL -- If BOOL is non-nil for a stream type client process,
return without waiting for the connection to complete; instead, the
:plist PLIST -- Install PLIST as the new process' initial plist.
-:server BOOL -- if BOOL is non-nil, create a server process for the
+:server QLEN -- if QLEN is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
-Default is a client process.
+If QLEN is an integer, it is used as the max. length of the server's
+pending connection queue (also known as the backlog); the default
+queue length is 5. Default is to create a client process.
+
+The following network options can be specified for this connection:
+
+:broadcast BOOL -- Allow send and receive of datagram broadcasts.
+:dontroute BOOL -- Only send to directly connected hosts.
+:keepalive BOOL -- Send keep-alive messages on network stream.
+:linger BOOL or TIMEOUT -- Send queued messages before closing.
+:oobinline BOOL -- Place out-of-band data in receive data stream.
+:priority INT -- Set protocol defined priority for sent packets.
+:reuseaddr BOOL -- Allow reusing a recently used local address
+ (this is allowed by default for a server process).
+:bindtodevice NAME -- bind to interface NAME. Using this may require
+ special privileges on some systems.
+
+Consult the relevant system programmer's manual pages for more
+information on using these options.
+
+
+A server process will listen for and accept connections from clients.
+When a client connection is accepted, a new network process is created
+for the connection with the following parameters:
-A server process will listen for and accept connections from
-clients. When a client connection is accepted, a new network process
-is created for the connection with the following parameters:
- The client's process name is constructed by concatenating the server
process' NAME and a client identification string.
- If the FILTER argument is non-nil, the client process will not get a
Lisp_Object name, buffer, host, service, address;
Lisp_Object filter, sentinel;
int is_non_blocking_client = 0;
- int is_server = 0;
+ int is_server = 0, backlog = 5;
int socktype;
int family = -1;
error ("Network servers not supported");
#else
is_server = 1;
+ if (INTEGERP (tem))
+ backlog = XINT (tem);
#endif
}
for (lres = res; lres; lres = lres->ai_next)
{
+ int optn, optbits;
+
s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
if (s < 0)
{
/* Make us close S if quit. */
record_unwind_protect (close_file_unwind, make_number (s));
+ /* Parse network options in the arg list.
+ We simply ignore anything which isn't a known option (including other keywords).
+ An error is signalled if setting a known option fails. */
+ for (optn = optbits = 0; optn < nargs-1; optn += 2)
+ optbits |= set_socket_option (s, args[optn], args[optn+1]);
+
if (is_server)
{
/* Configure as a server socket. */
+
+ /* SO_REUSEADDR = 1 is default for server sockets; must specify
+ explicit :reuseaddr key to override this. */
#ifdef HAVE_LOCAL_SOCKETS
if (family != AF_LOCAL)
#endif
- {
- int optval = 1;
- if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
- report_file_error ("Cannot set reuse option on server socket.", Qnil);
- }
+ if (!(optbits & (1 << OPIX_REUSEADDR)))
+ {
+ int optval = 1;
+ if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
+ report_file_error ("Cannot set reuse option on server socket", Qnil);
+ }
if (bind (s, lres->ai_addr, lres->ai_addrlen))
report_file_error ("Cannot bind server socket", Qnil);
}
#endif
- if (socktype == SOCK_STREAM && listen (s, 5))
+ if (socktype == SOCK_STREAM && listen (s, backlog))
report_file_error ("Cannot listen on server socket", Qnil);
break;
report_file_error ("make client process failed", contact);
}
- tem = Fplist_get (contact, QCoptions);
- if (!NILP (tem))
- set_socket_options (s, tem, 1);
-
#endif /* not TERM */
inch = s;
Lisp_Object args[5], val;
if (!NILP (tem))
- val = XCAR (XCDR (tem));
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCAR (val);
+ }
else if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
p->decode_coding_system = val;
if (!NILP (tem))
- val = XCAR (XCDR (tem));
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCDR (val);
+ }
else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (current_buffer->enable_multibyte_characters))
#endif /* HAVE_SOCKETS */
\f
-#ifdef HAVE_SOCKETS
+#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
#ifdef SIOCGIFCONF
DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
doc: /* Return an alist of all network interfaces and their network address.
Each element is a cons, the car of which is a string containing the
interface name, and the cdr is the network address in internal
-format; see the description of ADDRESS in 'make-network-process'. */)
+format; see the description of ADDRESS in `make-network-process'. */)
()
{
struct ifconf ifconf;
return res;
}
-#endif
+#endif /* SIOCGIFCONF */
#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
{ 0, 0 }
};
-DEFUN ("get-network-interface-info", Fget_network_interface_info, Sget_network_interface_info, 1, 1, 0,
+DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
doc: /* Return information about network interface named IFNAME.
The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
return Qnil;
elt = Qnil;
-#ifdef SIOCGIFFLAGS
+#if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
{
int flags = rq.ifr_flags;
res = Fcons (elt, res);
elt = Qnil;
-#ifdef SIOCGIFHWADDR
+#if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
{
- Lisp_Object hwaddr = Fmake_vector (6, Qnil);
+ Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
register struct Lisp_Vector *p = XVECTOR (hwaddr);
int n;
any++;
for (n = 0; n < 6; n++)
p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
- elt = Fcons (XINT (rq.ifr_hwaddr.sa_family), hwaddr);
+ elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
}
#endif
res = Fcons (elt, res);
elt = Qnil;
-#ifdef SIOCGIFNETMASK
+#if defined(SIOCGIFNETMASK) && defined(ifr_netmask)
if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
{
any++;
res = Fcons (elt, res);
elt = Qnil;
-#ifdef SIOCGIFBRDADDR
+#if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
{
any++;
res = Fcons (elt, res);
elt = Qnil;
-#ifdef SIOCGIFADDR
+#if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
if (ioctl (s, SIOCGIFADDR, &rq) == 0)
{
any++;
inchannel = XINT (p->infd);
outchannel = XINT (p->outfd);
+#ifdef ADAPTIVE_READ_BUFFERING
+ if (XINT (p->read_output_delay) > 0)
+ {
+ if (--process_output_delay_count < 0)
+ process_output_delay_count = 0;
+ XSETINT (p->read_output_delay, 0);
+ p->read_output_skip = Qnil;
+ }
+#endif
+
if (inchannel >= 0)
{
/* Beware SIGCHLD hereabouts. */
register int channel, nfds;
static SELECT_TYPE Available;
static SELECT_TYPE Connecting;
- int check_connect, no_avail;
+ int check_connect, check_delay, no_avail;
int xerrno;
Lisp_Object proc;
EMACS_TIME timeout, end_time;
Otherwise, do pending quit if requested. */
if (XINT (read_kbd) >= 0)
QUIT;
+#ifdef SYNC_INPUT
+ else if (interrupt_input_pending)
+ handle_async_input ();
+#endif
/* Exit now if the cell we're waiting for became non-nil. */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
if (!NILP (wait_for_cell))
{
Available = non_process_wait_mask;
- check_connect = 0;
+ check_connect = check_delay = 0;
}
else
{
else
Available = input_wait_mask;
check_connect = (num_pending_connects > 0);
+ check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
}
/* If frame size has changed or the window is newly mapped,
{
if (check_connect)
Connecting = connect_wait_mask;
+
+#ifdef ADAPTIVE_READ_BUFFERING
+ 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;
+ for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
+ {
+ proc = chan_process[channel];
+ if (NILP (proc))
+ continue;
+ if (XINT (XPROCESS (proc)->read_output_delay) > 0)
+ {
+ check_delay--;
+ if (NILP (XPROCESS (proc)->read_output_skip))
+ continue;
+ FD_CLR (channel, &Available);
+ XPROCESS (proc)->read_output_skip = Qnil;
+ if (XINT (XPROCESS (proc)->read_output_delay) < usecs)
+ usecs = XINT (XPROCESS (proc)->read_output_delay);
+ }
+ }
+ EMACS_SET_SECS_USECS (timeout, 0, usecs);
+ process_output_skip = 0;
+ }
+#endif
+
nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
&Available,
(check_connect ? &Connecting : (SELECT_TYPE *)0),
Lisp_Object proc;
register int channel;
{
- register int nchars, nbytes;
+ register int nbytes;
char *chars;
register Lisp_Object outstream;
register struct buffer *old = current_buffer;
else
#endif
if (proc_buffered_char[channel] < 0)
- nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
+ {
+ nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
+#ifdef ADAPTIVE_READ_BUFFERING
+ if (!NILP (p->adaptive_read_buffering))
+ {
+ int delay = XINT (p->read_output_delay);
+ if (nbytes < 256)
+ {
+ if (delay < READ_OUTPUT_DELAY_MAX_MAX)
+ {
+ if (delay == 0)
+ process_output_delay_count++;
+ delay += READ_OUTPUT_DELAY_INCREMENT * 2;
+ }
+ }
+ else if (delay > 0 && (nbytes == readmax - carryover))
+ {
+ delay -= READ_OUTPUT_DELAY_INCREMENT;
+ if (delay == 0)
+ process_output_delay_count--;
+ }
+ XSETINT (p->read_output_delay, delay);
+ if (delay)
+ {
+ p->read_output_skip = Qt;
+ process_output_skip = 1;
+ }
+ }
+#endif
+ }
else
{
chars[carryover] = proc_buffered_char[channel];
volatile Lisp_Object object;
{
/* Use volatile to protect variables from being clobbered by longjmp. */
+ struct Lisp_Process *p = XPROCESS (proc);
int rv;
struct coding_system *coding;
struct gcpro gcpro1;
GCPRO1 (object);
#ifdef VMS
- struct Lisp_Process *p = XPROCESS (proc);
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
#endif /* VMS */
- if (! NILP (XPROCESS (proc)->raw_status_low))
- update_status (XPROCESS (proc));
- if (! EQ (XPROCESS (proc)->status, Qrun))
- error ("Process %s not running",
- SDATA (XPROCESS (proc)->name));
- if (XINT (XPROCESS (proc)->outfd) < 0)
- error ("Output file descriptor of %s is closed",
- SDATA (XPROCESS (proc)->name));
+ if (! NILP (p->raw_status_low))
+ update_status (p);
+ if (! EQ (p->status, Qrun))
+ error ("Process %s not running", SDATA (p->name));
+ if (XINT (p->outfd) < 0)
+ error ("Output file descriptor of %s is closed", SDATA (p->name));
- coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
+ coding = proc_encode_coding_system[XINT (p->outfd)];
Vlast_coding_system_used = coding->symbol;
if ((STRINGP (object) && STRING_MULTIBYTE (object))
&& !NILP (XBUFFER (object)->enable_multibyte_characters))
|| EQ (object, Qt))
{
- if (!EQ (coding->symbol, XPROCESS (proc)->encode_coding_system))
+ if (!EQ (coding->symbol, p->encode_coding_system))
/* The coding system for encoding was changed to raw-text
because we sent a unibyte text previously. Now we are
sending a multibyte text, thus we must encode it by the
- original coding system specified for the current
- process. */
- setup_coding_system (XPROCESS (proc)->encode_coding_system, coding);
+ original coding system specified for the current process. */
+ setup_coding_system (p->encode_coding_system, coding);
/* src_multibyte should be set to 1 _after_ a call to
setup_coding_system, since it resets src_multibyte to
zero. */
{
int require = encoding_buffer_size (coding, len);
int from_byte = -1, from = -1, to = -1;
- unsigned char *temp_buf = NULL;
if (BUFFERP (object))
{
coding->composing = COMPOSITION_DISABLED;
}
- if (SBYTES (XPROCESS (proc)->encoding_buf) < require)
- XPROCESS (proc)->encoding_buf = make_uninit_string (require);
+ if (SBYTES (p->encoding_buf) < require)
+ p->encoding_buf = make_uninit_string (require);
if (from_byte >= 0)
buf = (BUFFERP (object)
? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
: SDATA (object) + from_byte);
- object = XPROCESS (proc)->encoding_buf;
+ object = p->encoding_buf;
encode_coding (coding, (char *) buf, SDATA (object),
len, SBYTES (object));
len = coding->produced;
buf = SDATA (object);
- if (temp_buf)
- xfree (temp_buf);
}
#ifdef VMS
if (pty_max_bytes == 0)
{
#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
- pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd),
- _PC_MAX_CANON);
+ pty_max_bytes = fpathconf (XFASTINT (p->outfd), _PC_MAX_CANON);
if (pty_max_bytes < 0)
pty_max_bytes = 250;
#else
/* Decide how much data we can send in one batch.
Long lines need to be split into multiple batches. */
- if (!NILP (XPROCESS (proc)->pty_flag))
+ if (!NILP (p->pty_flag))
{
/* Starting this at zero is always correct when not the first
iteration because the previous iteration ended by sending C-d.
/* Send this batch, using one or more write calls. */
while (this > 0)
{
- int outfd = XINT (XPROCESS (proc)->outfd);
+ int outfd = XINT (p->outfd);
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
#ifdef DATAGRAM_SOCKETS
if (DATAGRAM_CHAN_P (outfd))
}
else
#endif
- rv = emacs_write (outfd, (char *) buf, this);
+ {
+ rv = emacs_write (outfd, (char *) buf, this);
+#ifdef ADAPTIVE_READ_BUFFERING
+ if (XINT (p->read_output_delay) > 0
+ && EQ (p->adaptive_read_buffering, Qt))
+ {
+ XSETFASTINT (p->read_output_delay, 0);
+ process_output_delay_count--;
+ p->read_output_skip = Qnil;
+ }
+#endif
+ }
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
if (errno == EAGAIN)
{
int flags = FWRITE;
- ioctl (XINT (XPROCESS (proc)->outfd), TIOCFLUSH,
- &flags);
+ ioctl (XINT (p->outfd), TIOCFLUSH, &flags);
}
#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
{
#ifndef VMS
proc = process_sent_to;
+ p = XPROCESS (proc);
#endif
- XPROCESS (proc)->raw_status_low = Qnil;
- XPROCESS (proc)->raw_status_high = Qnil;
- XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
- XSETINT (XPROCESS (proc)->tick, ++process_tick);
+ p->raw_status_low = Qnil;
+ p->raw_status_high = Qnil;
+ p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
+ XSETINT (p->tick, ++process_tick);
deactivate_process (proc);
#ifdef VMS
- error ("Error writing to process %s; closed it",
- SDATA (XPROCESS (proc)->name));
+ error ("Error writing to process %s; closed it", SDATA (p->name));
#else
- error ("SIGPIPE raised on process %s; closed it",
- SDATA (XPROCESS (proc)->name));
+ error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
#endif
}
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. */
+ Inc.
+
+ ** Malloc WARNING: This should never call malloc either directly or
+ indirectly; if it does, that is a bug */
SIGTYPE
sigchld_handler (signo)
if (WIFEXITED (w))
synch_process_retcode = WRETCODE (w);
else if (WIFSIGNALED (w))
- {
- int code = WTERMSIG (w);
- char *signame;
-
- synchronize_system_messages_locale ();
- signame = strsignal (code);
-
- if (signame == 0)
- signame = "unknown";
-
- synch_process_death = signame;
- }
+ synch_process_termsig = WTERMSIG (w);
/* Tell wait_reading_process_input that it needs to wake up and
look around. */
FD_ZERO (&non_process_wait_mask);
max_process_desc = 0;
+#ifdef ADAPTIVE_READ_BUFFERING
+ process_output_delay_count = 0;
+ process_output_skip = 0;
+#endif
+
FD_SET (0, &input_wait_mask);
Vprocess_alist = Qnil;
#ifdef HAVE_SOCKETS
{
Lisp_Object subfeatures = Qnil;
+ struct socket_options *sopt;
+
#define ADD_SUBFEATURE(key, val) \
subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
ADD_SUBFEATURE (QCserver, Qt);
#endif
-#ifdef SO_BINDTODEVICE
- ADD_SUBFEATURE (QCoptions, intern ("bindtodevice"));
-#endif
-#ifdef SO_BROADCAST
- ADD_SUBFEATURE (QCoptions, intern ("broadcast"));
-#endif
-#ifdef SO_DONTROUTE
- ADD_SUBFEATURE (QCoptions, intern ("dontroute"));
-#endif
-#ifdef SO_KEEPALIVE
- ADD_SUBFEATURE (QCoptions, intern ("keepalive"));
-#endif
-#ifdef SO_LINGER
- ADD_SUBFEATURE (QCoptions, intern ("linger"));
-#endif
-#ifdef SO_OOBINLINE
- ADD_SUBFEATURE (QCoptions, intern ("oobinline"));
-#endif
-#ifdef SO_PRIORITY
- ADD_SUBFEATURE (QCoptions, intern ("priority"));
-#endif
-#ifdef SO_REUSEADDR
- ADD_SUBFEATURE (QCoptions, intern ("reuseaddr"));
-#endif
+
+ for (sopt = socket_options; sopt->name; sopt++)
+ subfeatures = Fcons (intern (sopt->name), subfeatures);
+
Fprovide (intern ("make-network-process"), subfeatures);
}
#endif /* HAVE_SOCKETS */
The value takes effect when `start-process' is called. */);
Vprocess_connection_type = Qt;
+#ifdef ADAPTIVE_READ_BUFFERING
+ DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering,
+ doc: /* If non-nil, improve receive buffering by delaying after short reads.
+On some systems, when emacs reads the output from a subprocess, the output data
+is read in very small blocks, potentially resulting in very poor performance.
+This behaviour can be remedied to some extent by setting this variable to a
+non-nil value, as it will automatically delay reading from such processes, to
+allowing them to produce more output before emacs tries to read it.
+If the value is t, the delay is reset after each write to the process; any other
+non-nil value means that the delay is not reset on write.
+The variable takes effect when `start-process' is called. */);
+ Vprocess_adaptive_read_buffering = Qt;
+#endif
+
defsubr (&Sprocessp);
defsubr (&Sget_process);
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
- defsubr (&Sset_network_process_options);
+ defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
defsubr (&Sformat_network_address);
+#endif /* HAVE_SOCKETS */
+#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
#ifdef SIOCGIFCONF
defsubr (&Snetwork_interface_list);
#endif
#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
- defsubr (&Sget_network_interface_info);
+ defsubr (&Snetwork_interface_info);
#endif
-#endif /* HAVE_SOCKETS */
+#endif /* HAVE_SOCKETS ... */
#ifdef DATAGRAM_SOCKETS
defsubr (&Sprocess_datagram_address);
defsubr (&Sset_process_datagram_address);