Mercurial > hg > xemacs-beta
diff src/process.c @ 398:74fd4e045ea6 r21-2-29
Import from CVS: tag r21-2-29
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:13:30 +0200 |
parents | 8626e4521993 |
children | a86b2b5e0111 |
line wrap: on
line diff
--- a/src/process.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/process.c Mon Aug 13 11:13:30 2007 +0200 @@ -58,7 +58,7 @@ #include "systty.h" #include "syswait.h" -Lisp_Object Qprocessp; +Lisp_Object Qprocessp, Qprocess_live_p; /* Process methods */ struct process_methods the_process_methods; @@ -71,7 +71,7 @@ /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ Lisp_Object Qopen, Qclosed; /* Protocol families */ -Lisp_Object Qtcpip; +Lisp_Object Qtcp, Qudp; #ifdef HAVE_MULTICAST Lisp_Object Qmulticast; /* Will be used for occasional warnings */ @@ -106,25 +106,27 @@ /* List of process objects. */ Lisp_Object Vprocess_list; +extern Lisp_Object Vlisp_EXEC_SUFFIXES; + static Lisp_Object -mark_process (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_process (Lisp_Object obj) { - struct Lisp_Process *proc = XPROCESS (obj); - MAYBE_PROCMETH (mark_process_data, (proc, markobj)); - markobj (proc->name); - markobj (proc->command); - markobj (proc->filter); - markobj (proc->sentinel); - markobj (proc->buffer); - markobj (proc->mark); - markobj (proc->pid); - markobj (proc->pipe_instream); - markobj (proc->pipe_outstream); + Lisp_Process *proc = XPROCESS (obj); + MAYBE_PROCMETH (mark_process_data, (proc)); + mark_object (proc->name); + mark_object (proc->command); + mark_object (proc->filter); + mark_object (proc->sentinel); + mark_object (proc->buffer); + mark_object (proc->mark); + mark_object (proc->pid); + mark_object (proc->pipe_instream); + mark_object (proc->pipe_outstream); #ifdef FILE_CODING - markobj (proc->coding_instream); - markobj (proc->coding_outstream); + mark_object (proc->coding_instream); + mark_object (proc->coding_outstream); #endif return proc->status_symbol; } @@ -132,7 +134,7 @@ static void print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Process *proc = XPROCESS (obj); + Lisp_Process *proc = XPROCESS (obj); if (print_readably) error ("printing unreadable object #<process %s>", @@ -145,10 +147,10 @@ else { int netp = network_connection_p (obj); - write_c_string (((netp) ? GETTEXT ("#<network connection ") : + write_c_string ((netp ? GETTEXT ("#<network connection ") : GETTEXT ("#<process ")), printcharfun); print_internal (proc->name, printcharfun, 1); - write_c_string (((netp) ? " " : " pid "), printcharfun); + write_c_string ((netp ? " " : " pid "), printcharfun); print_internal (proc->pid, printcharfun, 1); write_c_string (" state:", printcharfun); print_internal (proc->status_symbol, printcharfun, 1); @@ -158,7 +160,7 @@ } #ifdef HAVE_WINDOW_SYSTEM -extern void debug_process_finalization (struct Lisp_Process *p); +extern void debug_process_finalization (Lisp_Process *p); #endif /* HAVE_WINDOW_SYSTEM */ static void @@ -166,7 +168,7 @@ { /* #### this probably needs to be tied into the tty event loop */ /* #### when there is one */ - struct Lisp_Process *p = (struct Lisp_Process *) header; + Lisp_Process *p = (Lisp_Process *) header; #ifdef HAVE_WINDOW_SYSTEM if (!for_disksave) { @@ -184,7 +186,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("process", process, mark_process, print_process, finalize_process, - 0, 0, struct Lisp_Process); + 0, 0, 0, Lisp_Process); /************************************************************************/ /* basic process accessors */ @@ -194,8 +196,7 @@ directly 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) +get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr) { assert (p); assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream)); @@ -204,14 +205,14 @@ *outstr = p->pipe_outstream; } -struct Lisp_Process * +Lisp_Process * get_process_from_usid (USID usid) { - CONST void *vval; + const void *vval; assert (usid != USID_ERROR && usid != USID_DONTHASH); - if (gethash ((CONST void*)usid, usid_to_process, &vval)) + if (gethash ((const void*)usid, usid_to_process, &vval)) { Lisp_Object proc; CVOID_TO_LISP (proc, vval); @@ -222,19 +223,19 @@ } int -get_process_selected_p (struct Lisp_Process *p) +get_process_selected_p (Lisp_Process *p) { return p->selected; } void -set_process_selected_p (struct Lisp_Process *p, int selected_p) +set_process_selected_p (Lisp_Process *p, int selected_p) { p->selected = !!selected_p; } int -connected_via_filedesc_p (struct Lisp_Process *p) +connected_via_filedesc_p (Lisp_Process *p) { return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); } @@ -243,7 +244,7 @@ int network_connection_p (Lisp_Object process) { - return GC_CONSP (XPROCESS (process)->pid); + return CONSP (XPROCESS (process)->pid); } #endif @@ -255,6 +256,14 @@ return PROCESSP (obj) ? Qt : Qnil; } +DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /* +Return t if OBJECT is a process that is alive. +*/ + (obj)) +{ + return PROCESSP (obj) && PROCESS_LIVE_P (XPROCESS (obj)) ? Qt : Qnil; +} + DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* Return a list of all processes. */ @@ -270,7 +279,7 @@ { Lisp_Object tail; - if (GC_PROCESSP (name)) + if (PROCESSP (name)) return name; if (!gc_in_progress) @@ -278,7 +287,7 @@ of a signal or crash. */ CHECK_STRING (name); - for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object proc = XCAR (tail); QUIT; @@ -296,18 +305,18 @@ { Lisp_Object buf, tail, proc; - if (GC_NILP (name)) return Qnil; + if (NILP (name)) return Qnil; buf = Fget_buffer (name); - if (GC_NILP (buf)) return Qnil; + if (NILP (buf)) return Qnil; - for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { /* jwz: do not quit here - it isn't necessary, as there is no way for Vprocess_list to get circular or overwhelmingly long, and this function is called from layout_mode_element under redisplay. */ /* QUIT; */ proc = XCAR (tail); - if (GC_PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) + if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) return proc; } return Qnil; @@ -329,28 +338,28 @@ /* This may be called during a GC from process_send_signal() from kill_buffer_processes() if emacs decides to abort(). */ - if (GC_PROCESSP (name)) + if (PROCESSP (name)) return name; - if (GC_STRINGP (name)) + if (STRINGP (name)) { obj = Fget_process (name); - if (GC_NILP (obj)) + if (NILP (obj)) obj = Fget_buffer (name); - if (GC_NILP (obj)) + if (NILP (obj)) error ("Process %s does not exist", XSTRING_DATA (name)); } - else if (GC_NILP (name)) + else if (NILP (name)) obj = Fcurrent_buffer (); else obj = name; /* Now obj should be either a buffer object or a process object. */ - if (GC_BUFFERP (obj)) + if (BUFFERP (obj)) { proc = Fget_buffer_process (obj); - if (GC_NILP (proc)) + if (NILP (proc)) error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); } else @@ -414,8 +423,7 @@ { Lisp_Object val, name1; int i; - struct Lisp_Process *p = - alloc_lcrecord_type (struct Lisp_Process, lrecord_process); + Lisp_Process *p = alloc_lcrecord_type (Lisp_Process, &lrecord_process); /* If name is already in use, modify it until it is unused. */ name1 = name; @@ -462,7 +470,7 @@ } void -init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) +init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags) { USID usid = event_stream_create_stream_pair (in, out, &p->pipe_instream, &p->pipe_outstream, @@ -475,7 +483,7 @@ { Lisp_Object proc = Qnil; XSETPROCESS (proc, p); - puthash ((CONST void*)usid, LISP_TO_VOID (proc), usid_to_process); + puthash ((const void*)usid, LISP_TO_VOID (proc), usid_to_process); } MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags)); @@ -497,7 +505,7 @@ create_process (Lisp_Object process, Lisp_Object *argv, int nargv, Lisp_Object program, Lisp_Object cur_dir) { - struct Lisp_Process *p = XPROCESS (process); + Lisp_Process *p = XPROCESS (process); int pid; /* *_create_process may change status_symbol, if the process @@ -508,7 +516,7 @@ pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir)); p->pid = make_int (pid); - if (!NILP(p->pipe_instream)) + if (PROCESS_LIVE_P (p)) event_stream_select_process (p); } @@ -591,8 +599,7 @@ tem = Qnil; NGCPRO1 (tem); - locate_file (Vexec_path, program, EXEC_SUFFIXES, &tem, - X_OK); + locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK); if (NILP (tem)) report_file_error ("Searching for program", list1 (program)); program = Fexpand_file_name (tem, Qnil); @@ -658,7 +665,7 @@ 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. +Return a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. NAME is name for process. It is modified if necessary to make it unique. @@ -670,10 +677,18 @@ 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. +Fifth argument PROTOCOL is a network protocol. Currently 'tcp + (Transmission Control Protocol) and 'udp (User Datagram Protocol) are + supported. When omitted, 'tcp is assumed. + +Ouput via `process-send-string' and input via buffer or filter (see +`set-process-filter') are stream-oriented. That means UDP datagrams are +not guaranteed to be sent and received in discrete packets. (But small +datagrams around 500 bytes that are not truncated by `process-send-string' +are usually fine.) Note further that UDP protocol does not guard against +lost packets. */ - (name, buffer, host, service, family)) + (name, buffer, host, service, protocol)) { /* !!#### This function has not been Mule-ized */ /* This function can GC */ @@ -681,17 +696,17 @@ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; void *inch, *outch; - GCPRO5 (name, buffer, host, service, family); + GCPRO5 (name, buffer, host, service, protocol); CHECK_STRING (name); - if (NILP(family)) - family = Qtcpip; + if (NILP(protocol)) + protocol = Qtcp; else - CHECK_SYMBOL (family); + CHECK_SYMBOL (protocol); /* Since this code is inside HAVE_SOCKETS, existence of open_network_stream is mandatory */ - PROCMETH (open_network_stream, (name, host, service, family, + PROCMETH (open_network_stream, (name, host, service, protocol, &inch, &outch)); if (!NILP (buffer)) @@ -715,7 +730,7 @@ 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. +Return a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. NAME is name for process. It is modified if necessary to make it unique. @@ -804,7 +819,7 @@ Bytecount nbytes, nchars; Bufbyte chars[1024]; Lisp_Object outstream; - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); /* If there is a lot of output from the subprocess, the loop in execute_internal_event() might call read_process_output() more @@ -814,7 +829,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 (NILP(p->pipe_instream)) + if (!PROCESS_LIVE_P (p)) return -1; /* already closed */ if (!NILP (p->filter) && (p->filter_does_read)) @@ -949,7 +964,7 @@ void send_process (Lisp_Object proc, - Lisp_Object relocatable, CONST Bufbyte *nonrelocatable, + Lisp_Object relocatable, const Bufbyte *nonrelocatable, int start, int len) { /* This function can GC */ @@ -964,7 +979,7 @@ if (nonrelocatable) lstream = make_fixed_buffer_input_stream (nonrelocatable + start, len); - else if (GC_BUFFERP (relocatable)) + else if (BUFFERP (relocatable)) lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), start, start + len, 0); else @@ -1023,7 +1038,7 @@ set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read) { CHECK_PROCESS (proc); - if (PROCESS_LIVE_P (proc)) { + if (PROCESS_LIVE_P (XPROCESS (proc))) { if (EQ (filter, Qt)) event_stream_unselect_process (XPROCESS (proc)); else @@ -1112,6 +1127,7 @@ (process)) { process = get_process (process); + CHECK_LIVE_PROCESS (process); return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) ); } @@ -1121,6 +1137,7 @@ (process)) { process = get_process (process); + CHECK_LIVE_PROCESS (process); return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream)); } @@ -1130,6 +1147,7 @@ (process)) { process = get_process (process); + CHECK_LIVE_PROCESS (process); return Fcons (decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream)), encoding_stream_coding_system @@ -1144,6 +1162,8 @@ { codesys = Fget_coding_system (codesys); process = get_process (process); + CHECK_LIVE_PROCESS (process); + set_decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream), codesys); return Qnil; @@ -1157,6 +1177,8 @@ { codesys = Fget_coding_system (codesys); process = get_process (process); + CHECK_LIVE_PROCESS (process); + set_encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); return Qnil; @@ -1165,6 +1187,8 @@ DEFUN ("set-process-coding-system", Fset_process_coding_system, 1, 3, 0, /* Set coding-systems of PROCESS to DECODING and ENCODING. +DECODING will be used to decode subprocess output and ENCODING to +encode subprocess input. */ (process, decoding, encoding)) { @@ -1186,7 +1210,7 @@ static Lisp_Object exec_sentinel_unwind (Lisp_Object datum) { - struct Lisp_Cons *d = XCONS (datum); + Lisp_Cons *d = XCONS (datum); XPROCESS (d->car)->sentinel = d->cdr; free_cons (d); return Qnil; @@ -1197,7 +1221,7 @@ { /* This function can GC */ int speccount = specpdl_depth (); - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); Lisp_Object sentinel = p->sentinel; if (NILP (sentinel)) @@ -1242,13 +1266,13 @@ } -CONST char * +const char * signal_name (int signum) { if (signum >= 0 && signum < NSIG) - return (CONST char *) sys_siglist[signum]; + return (const char *) sys_siglist[signum]; - return (CONST char *) GETTEXT ("unknown signal"); + return (const char *) GETTEXT ("unknown signal"); } void @@ -1267,7 +1291,7 @@ /* Return a string describing a process status list. */ static Lisp_Object -status_message (struct Lisp_Process *p) +status_message (Lisp_Process *p) { Lisp_Object symbol = p->status_symbol; int code = p->exit_code; @@ -1351,7 +1375,7 @@ for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object proc = XCAR (tail); - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); /* p->tick is also volatile. Same thing as above applies. */ int this_process_tick; @@ -1518,9 +1542,7 @@ if (network_connection_p (proc)) error ("Network connection %s is not a subprocess", XSTRING_DATA (XPROCESS(proc)->name)); - if (!PROCESS_LIVE_P (proc)) - error ("Process %s is not active", - XSTRING_DATA (XPROCESS(proc)->name)); + CHECK_LIVE_PROCESS (proc); MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg)); } @@ -1621,7 +1643,7 @@ name = string_data (XSYMBOL (sigcode)->name); #define handle_signal(signal) \ - else if (!strcmp ((CONST char *) name, #signal)) \ + else if (!strcmp ((const char *) name, #signal)) \ XSETINT (sigcode, signal) if (0) @@ -1810,7 +1832,7 @@ void deactivate_process (Lisp_Object proc) { - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); USID usid; /* It's possible that we got as far in the process-creation @@ -1837,7 +1859,7 @@ p->pipe_outstream); if (usid != USID_DONTHASH) - remhash ((CONST void*)usid, usid_to_process); + remhash ((const void*)usid, usid_to_process); p->pipe_instream = Qnil; p->pipe_outstream = Qnil; @@ -1863,7 +1885,7 @@ (proc)) { /* This function can GC */ - struct Lisp_Process *p; + Lisp_Process *p; proc = get_process (proc); p = XPROCESS (proc); if (network_connection_p (proc)) @@ -1874,7 +1896,7 @@ p->tick++; process_tick++; } - else if (!NILP(p->pipe_instream)) + else if (PROCESS_LIVE_P (p)) { Fkill_process (proc, Qnil); /* Do this now, since remove_process will make sigchld_handler do nothing. */ @@ -1897,16 +1919,16 @@ { Lisp_Object tail; - for (tail = Vprocess_list; GC_CONSP (tail); + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object proc = XCAR (tail); - if (GC_PROCESSP (proc) - && (GC_NILP (buffer) || GC_EQ (XPROCESS (proc)->buffer, buffer))) + if (PROCESSP (proc) + && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) { if (network_connection_p (proc)) Fdelete_process (proc); - else if (!NILP (XPROCESS (proc)->pipe_instream)) + else if (PROCESS_LIVE_P (XPROCESS (proc))) process_send_signal (proc, SIGHUP, 0, 1); } } @@ -1969,18 +1991,21 @@ syms_of_process (void) { defsymbol (&Qprocessp, "processp"); + defsymbol (&Qprocess_live_p, "process-live-p"); defsymbol (&Qrun, "run"); defsymbol (&Qstop, "stop"); defsymbol (&Qopen, "open"); defsymbol (&Qclosed, "closed"); - defsymbol (&Qtcpip, "tcp/ip"); + defsymbol (&Qtcp, "tcp"); + defsymbol (&Qudp, "udp"); #ifdef HAVE_MULTICAST defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ #endif DEFSUBR (Fprocessp); + DEFSUBR (Fprocess_live_p); DEFSUBR (Fget_process); DEFSUBR (Fget_buffer_process); DEFSUBR (Fdelete_process);