comparison 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
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
56 #include "systime.h" 56 #include "systime.h"
57 #include "syssignal.h" /* Always include before systty.h */ 57 #include "syssignal.h" /* Always include before systty.h */
58 #include "systty.h" 58 #include "systty.h"
59 #include "syswait.h" 59 #include "syswait.h"
60 60
61 Lisp_Object Qprocessp; 61 Lisp_Object Qprocessp, Qprocess_live_p;
62 62
63 /* Process methods */ 63 /* Process methods */
64 struct process_methods the_process_methods; 64 struct process_methods the_process_methods;
65 65
66 /* a process object is a network connection when its pid field a cons 66 /* a process object is a network connection when its pid field a cons
69 /* Valid values of process->status_symbol */ 69 /* Valid values of process->status_symbol */
70 Lisp_Object Qrun, Qstop; 70 Lisp_Object Qrun, Qstop;
71 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ 71 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */
72 Lisp_Object Qopen, Qclosed; 72 Lisp_Object Qopen, Qclosed;
73 /* Protocol families */ 73 /* Protocol families */
74 Lisp_Object Qtcpip; 74 Lisp_Object Qtcp, Qudp;
75 75
76 #ifdef HAVE_MULTICAST 76 #ifdef HAVE_MULTICAST
77 Lisp_Object Qmulticast; /* Will be used for occasional warnings */ 77 Lisp_Object Qmulticast; /* Will be used for occasional warnings */
78 #endif 78 #endif
79 79
104 struct hash_table *usid_to_process; 104 struct hash_table *usid_to_process;
105 105
106 /* List of process objects. */ 106 /* List of process objects. */
107 Lisp_Object Vprocess_list; 107 Lisp_Object Vprocess_list;
108 108
109 extern Lisp_Object Vlisp_EXEC_SUFFIXES;
110
109 111
110 112
111 static Lisp_Object 113 static Lisp_Object
112 mark_process (Lisp_Object obj, void (*markobj) (Lisp_Object)) 114 mark_process (Lisp_Object obj)
113 { 115 {
114 struct Lisp_Process *proc = XPROCESS (obj); 116 Lisp_Process *proc = XPROCESS (obj);
115 MAYBE_PROCMETH (mark_process_data, (proc, markobj)); 117 MAYBE_PROCMETH (mark_process_data, (proc));
116 markobj (proc->name); 118 mark_object (proc->name);
117 markobj (proc->command); 119 mark_object (proc->command);
118 markobj (proc->filter); 120 mark_object (proc->filter);
119 markobj (proc->sentinel); 121 mark_object (proc->sentinel);
120 markobj (proc->buffer); 122 mark_object (proc->buffer);
121 markobj (proc->mark); 123 mark_object (proc->mark);
122 markobj (proc->pid); 124 mark_object (proc->pid);
123 markobj (proc->pipe_instream); 125 mark_object (proc->pipe_instream);
124 markobj (proc->pipe_outstream); 126 mark_object (proc->pipe_outstream);
125 #ifdef FILE_CODING 127 #ifdef FILE_CODING
126 markobj (proc->coding_instream); 128 mark_object (proc->coding_instream);
127 markobj (proc->coding_outstream); 129 mark_object (proc->coding_outstream);
128 #endif 130 #endif
129 return proc->status_symbol; 131 return proc->status_symbol;
130 } 132 }
131 133
132 static void 134 static void
133 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 135 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
134 { 136 {
135 struct Lisp_Process *proc = XPROCESS (obj); 137 Lisp_Process *proc = XPROCESS (obj);
136 138
137 if (print_readably) 139 if (print_readably)
138 error ("printing unreadable object #<process %s>", 140 error ("printing unreadable object #<process %s>",
139 XSTRING_DATA (proc->name)); 141 XSTRING_DATA (proc->name));
140 142
143 print_internal (proc->name, printcharfun, 0); 145 print_internal (proc->name, printcharfun, 0);
144 } 146 }
145 else 147 else
146 { 148 {
147 int netp = network_connection_p (obj); 149 int netp = network_connection_p (obj);
148 write_c_string (((netp) ? GETTEXT ("#<network connection ") : 150 write_c_string ((netp ? GETTEXT ("#<network connection ") :
149 GETTEXT ("#<process ")), printcharfun); 151 GETTEXT ("#<process ")), printcharfun);
150 print_internal (proc->name, printcharfun, 1); 152 print_internal (proc->name, printcharfun, 1);
151 write_c_string (((netp) ? " " : " pid "), printcharfun); 153 write_c_string ((netp ? " " : " pid "), printcharfun);
152 print_internal (proc->pid, printcharfun, 1); 154 print_internal (proc->pid, printcharfun, 1);
153 write_c_string (" state:", printcharfun); 155 write_c_string (" state:", printcharfun);
154 print_internal (proc->status_symbol, printcharfun, 1); 156 print_internal (proc->status_symbol, printcharfun, 1);
155 MAYBE_PROCMETH (print_process_data, (proc, printcharfun)); 157 MAYBE_PROCMETH (print_process_data, (proc, printcharfun));
156 write_c_string (">", printcharfun); 158 write_c_string (">", printcharfun);
157 } 159 }
158 } 160 }
159 161
160 #ifdef HAVE_WINDOW_SYSTEM 162 #ifdef HAVE_WINDOW_SYSTEM
161 extern void debug_process_finalization (struct Lisp_Process *p); 163 extern void debug_process_finalization (Lisp_Process *p);
162 #endif /* HAVE_WINDOW_SYSTEM */ 164 #endif /* HAVE_WINDOW_SYSTEM */
163 165
164 static void 166 static void
165 finalize_process (void *header, int for_disksave) 167 finalize_process (void *header, int for_disksave)
166 { 168 {
167 /* #### this probably needs to be tied into the tty event loop */ 169 /* #### this probably needs to be tied into the tty event loop */
168 /* #### when there is one */ 170 /* #### when there is one */
169 struct Lisp_Process *p = (struct Lisp_Process *) header; 171 Lisp_Process *p = (Lisp_Process *) header;
170 #ifdef HAVE_WINDOW_SYSTEM 172 #ifdef HAVE_WINDOW_SYSTEM
171 if (!for_disksave) 173 if (!for_disksave)
172 { 174 {
173 debug_process_finalization (p); 175 debug_process_finalization (p);
174 } 176 }
182 } 184 }
183 } 185 }
184 186
185 DEFINE_LRECORD_IMPLEMENTATION ("process", process, 187 DEFINE_LRECORD_IMPLEMENTATION ("process", process,
186 mark_process, print_process, finalize_process, 188 mark_process, print_process, finalize_process,
187 0, 0, struct Lisp_Process); 189 0, 0, 0, Lisp_Process);
188 190
189 /************************************************************************/ 191 /************************************************************************/
190 /* basic process accessors */ 192 /* basic process accessors */
191 /************************************************************************/ 193 /************************************************************************/
192 194
193 /* Under FILE_CODING, this function returns low-level streams, connected 195 /* Under FILE_CODING, this function returns low-level streams, connected
194 directly to the child process, rather than en/decoding FILE_CODING 196 directly to the child process, rather than en/decoding FILE_CODING
195 streams */ 197 streams */
196 void 198 void
197 get_process_streams (struct Lisp_Process *p, 199 get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr)
198 Lisp_Object *instr, Lisp_Object *outstr)
199 { 200 {
200 assert (p); 201 assert (p);
201 assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream)); 202 assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream));
202 assert (NILP (p->pipe_outstream) || LSTREAMP(p->pipe_outstream)); 203 assert (NILP (p->pipe_outstream) || LSTREAMP(p->pipe_outstream));
203 *instr = p->pipe_instream; 204 *instr = p->pipe_instream;
204 *outstr = p->pipe_outstream; 205 *outstr = p->pipe_outstream;
205 } 206 }
206 207
207 struct Lisp_Process * 208 Lisp_Process *
208 get_process_from_usid (USID usid) 209 get_process_from_usid (USID usid)
209 { 210 {
210 CONST void *vval; 211 const void *vval;
211 212
212 assert (usid != USID_ERROR && usid != USID_DONTHASH); 213 assert (usid != USID_ERROR && usid != USID_DONTHASH);
213 214
214 if (gethash ((CONST void*)usid, usid_to_process, &vval)) 215 if (gethash ((const void*)usid, usid_to_process, &vval))
215 { 216 {
216 Lisp_Object proc; 217 Lisp_Object proc;
217 CVOID_TO_LISP (proc, vval); 218 CVOID_TO_LISP (proc, vval);
218 return XPROCESS (proc); 219 return XPROCESS (proc);
219 } 220 }
220 else 221 else
221 return 0; 222 return 0;
222 } 223 }
223 224
224 int 225 int
225 get_process_selected_p (struct Lisp_Process *p) 226 get_process_selected_p (Lisp_Process *p)
226 { 227 {
227 return p->selected; 228 return p->selected;
228 } 229 }
229 230
230 void 231 void
231 set_process_selected_p (struct Lisp_Process *p, int selected_p) 232 set_process_selected_p (Lisp_Process *p, int selected_p)
232 { 233 {
233 p->selected = !!selected_p; 234 p->selected = !!selected_p;
234 } 235 }
235 236
236 int 237 int
237 connected_via_filedesc_p (struct Lisp_Process *p) 238 connected_via_filedesc_p (Lisp_Process *p)
238 { 239 {
239 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); 240 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p));
240 } 241 }
241 242
242 #ifdef HAVE_SOCKETS 243 #ifdef HAVE_SOCKETS
243 int 244 int
244 network_connection_p (Lisp_Object process) 245 network_connection_p (Lisp_Object process)
245 { 246 {
246 return GC_CONSP (XPROCESS (process)->pid); 247 return CONSP (XPROCESS (process)->pid);
247 } 248 }
248 #endif 249 #endif
249 250
250 DEFUN ("processp", Fprocessp, 1, 1, 0, /* 251 DEFUN ("processp", Fprocessp, 1, 1, 0, /*
251 Return t if OBJECT is a process. 252 Return t if OBJECT is a process.
253 (obj)) 254 (obj))
254 { 255 {
255 return PROCESSP (obj) ? Qt : Qnil; 256 return PROCESSP (obj) ? Qt : Qnil;
256 } 257 }
257 258
259 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /*
260 Return t if OBJECT is a process that is alive.
261 */
262 (obj))
263 {
264 return PROCESSP (obj) && PROCESS_LIVE_P (XPROCESS (obj)) ? Qt : Qnil;
265 }
266
258 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* 267 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /*
259 Return a list of all processes. 268 Return a list of all processes.
260 */ 269 */
261 ()) 270 ())
262 { 271 {
268 */ 277 */
269 (name)) 278 (name))
270 { 279 {
271 Lisp_Object tail; 280 Lisp_Object tail;
272 281
273 if (GC_PROCESSP (name)) 282 if (PROCESSP (name))
274 return name; 283 return name;
275 284
276 if (!gc_in_progress) 285 if (!gc_in_progress)
277 /* this only gets called during GC when emacs is going away as a result 286 /* this only gets called during GC when emacs is going away as a result
278 of a signal or crash. */ 287 of a signal or crash. */
279 CHECK_STRING (name); 288 CHECK_STRING (name);
280 289
281 for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail)) 290 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
282 { 291 {
283 Lisp_Object proc = XCAR (tail); 292 Lisp_Object proc = XCAR (tail);
284 QUIT; 293 QUIT;
285 if (internal_equal (name, XPROCESS (proc)->name, 0)) 294 if (internal_equal (name, XPROCESS (proc)->name, 0))
286 return XCAR (tail); 295 return XCAR (tail);
294 */ 303 */
295 (name)) 304 (name))
296 { 305 {
297 Lisp_Object buf, tail, proc; 306 Lisp_Object buf, tail, proc;
298 307
299 if (GC_NILP (name)) return Qnil; 308 if (NILP (name)) return Qnil;
300 buf = Fget_buffer (name); 309 buf = Fget_buffer (name);
301 if (GC_NILP (buf)) return Qnil; 310 if (NILP (buf)) return Qnil;
302 311
303 for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail)) 312 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
304 { 313 {
305 /* jwz: do not quit here - it isn't necessary, as there is no way for 314 /* jwz: do not quit here - it isn't necessary, as there is no way for
306 Vprocess_list to get circular or overwhelmingly long, and this 315 Vprocess_list to get circular or overwhelmingly long, and this
307 function is called from layout_mode_element under redisplay. */ 316 function is called from layout_mode_element under redisplay. */
308 /* QUIT; */ 317 /* QUIT; */
309 proc = XCAR (tail); 318 proc = XCAR (tail);
310 if (GC_PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) 319 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
311 return proc; 320 return proc;
312 } 321 }
313 return Qnil; 322 return Qnil;
314 } 323 }
315 324
327 /* #### Look more closely into translating process names. */ 336 /* #### Look more closely into translating process names. */
328 #endif 337 #endif
329 338
330 /* This may be called during a GC from process_send_signal() from 339 /* This may be called during a GC from process_send_signal() from
331 kill_buffer_processes() if emacs decides to abort(). */ 340 kill_buffer_processes() if emacs decides to abort(). */
332 if (GC_PROCESSP (name)) 341 if (PROCESSP (name))
333 return name; 342 return name;
334 343
335 if (GC_STRINGP (name)) 344 if (STRINGP (name))
336 { 345 {
337 obj = Fget_process (name); 346 obj = Fget_process (name);
338 if (GC_NILP (obj)) 347 if (NILP (obj))
339 obj = Fget_buffer (name); 348 obj = Fget_buffer (name);
340 if (GC_NILP (obj)) 349 if (NILP (obj))
341 error ("Process %s does not exist", XSTRING_DATA (name)); 350 error ("Process %s does not exist", XSTRING_DATA (name));
342 } 351 }
343 else if (GC_NILP (name)) 352 else if (NILP (name))
344 obj = Fcurrent_buffer (); 353 obj = Fcurrent_buffer ();
345 else 354 else
346 obj = name; 355 obj = name;
347 356
348 /* Now obj should be either a buffer object or a process object. 357 /* Now obj should be either a buffer object or a process object.
349 */ 358 */
350 if (GC_BUFFERP (obj)) 359 if (BUFFERP (obj))
351 { 360 {
352 proc = Fget_buffer_process (obj); 361 proc = Fget_buffer_process (obj);
353 if (GC_NILP (proc)) 362 if (NILP (proc))
354 error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); 363 error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name));
355 } 364 }
356 else 365 else
357 { 366 {
358 /* #### This was commented out. Although, simple 367 /* #### This was commented out. Although, simple
412 Lisp_Object 421 Lisp_Object
413 make_process_internal (Lisp_Object name) 422 make_process_internal (Lisp_Object name)
414 { 423 {
415 Lisp_Object val, name1; 424 Lisp_Object val, name1;
416 int i; 425 int i;
417 struct Lisp_Process *p = 426 Lisp_Process *p = alloc_lcrecord_type (Lisp_Process, &lrecord_process);
418 alloc_lcrecord_type (struct Lisp_Process, lrecord_process);
419 427
420 /* If name is already in use, modify it until it is unused. */ 428 /* If name is already in use, modify it until it is unused. */
421 name1 = name; 429 name1 = name;
422 for (i = 1; ; i++) 430 for (i = 1; ; i++)
423 { 431 {
460 Vprocess_list = Fcons (val, Vprocess_list); 468 Vprocess_list = Fcons (val, Vprocess_list);
461 return val; 469 return val;
462 } 470 }
463 471
464 void 472 void
465 init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) 473 init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
466 { 474 {
467 USID usid = event_stream_create_stream_pair (in, out, 475 USID usid = event_stream_create_stream_pair (in, out,
468 &p->pipe_instream, &p->pipe_outstream, 476 &p->pipe_instream, &p->pipe_outstream,
469 flags); 477 flags);
470 478
473 481
474 if (usid != USID_DONTHASH) 482 if (usid != USID_DONTHASH)
475 { 483 {
476 Lisp_Object proc = Qnil; 484 Lisp_Object proc = Qnil;
477 XSETPROCESS (proc, p); 485 XSETPROCESS (proc, p);
478 puthash ((CONST void*)usid, LISP_TO_VOID (proc), usid_to_process); 486 puthash ((const void*)usid, LISP_TO_VOID (proc), usid_to_process);
479 } 487 }
480 488
481 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags)); 489 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags));
482 490
483 #ifdef FILE_CODING 491 #ifdef FILE_CODING
495 503
496 static void 504 static void
497 create_process (Lisp_Object process, Lisp_Object *argv, int nargv, 505 create_process (Lisp_Object process, Lisp_Object *argv, int nargv,
498 Lisp_Object program, Lisp_Object cur_dir) 506 Lisp_Object program, Lisp_Object cur_dir)
499 { 507 {
500 struct Lisp_Process *p = XPROCESS (process); 508 Lisp_Process *p = XPROCESS (process);
501 int pid; 509 int pid;
502 510
503 /* *_create_process may change status_symbol, if the process 511 /* *_create_process may change status_symbol, if the process
504 is a kind of "fire-and-forget" (no I/O, unwaitable) */ 512 is a kind of "fire-and-forget" (no I/O, unwaitable) */
505 p->status_symbol = Qrun; 513 p->status_symbol = Qrun;
506 p->exit_code = 0; 514 p->exit_code = 0;
507 515
508 pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir)); 516 pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir));
509 517
510 p->pid = make_int (pid); 518 p->pid = make_int (pid);
511 if (!NILP(p->pipe_instream)) 519 if (PROCESS_LIVE_P (p))
512 event_stream_select_process (p); 520 event_stream_select_process (p);
513 } 521 }
514 522
515 /* This function is the unwind_protect form for Fstart_process_internal. If 523 /* This function is the unwind_protect form for Fstart_process_internal. If
516 PROC doesn't have its pid set, then we know someone has signalled 524 PROC doesn't have its pid set, then we know someone has signalled
589 { 597 {
590 struct gcpro ngcpro1; 598 struct gcpro ngcpro1;
591 599
592 tem = Qnil; 600 tem = Qnil;
593 NGCPRO1 (tem); 601 NGCPRO1 (tem);
594 locate_file (Vexec_path, program, EXEC_SUFFIXES, &tem, 602 locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK);
595 X_OK);
596 if (NILP (tem)) 603 if (NILP (tem))
597 report_file_error ("Searching for program", list1 (program)); 604 report_file_error ("Searching for program", list1 (program));
598 program = Fexpand_file_name (tem, Qnil); 605 program = Fexpand_file_name (tem, Qnil);
599 NUNGCPRO; 606 NUNGCPRO;
600 } 607 }
656 connection has no PID; you cannot signal it. All you can do is 663 connection has no PID; you cannot signal it. All you can do is
657 deactivate and close it via delete-process */ 664 deactivate and close it via delete-process */
658 665
659 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /* 666 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /*
660 Open a TCP connection for a service to a host. 667 Open a TCP connection for a service to a host.
661 Returns a subprocess-object to represent the connection. 668 Return a subprocess-object to represent the connection.
662 Input and output work as for subprocesses; `delete-process' closes it. 669 Input and output work as for subprocesses; `delete-process' closes it.
663 670
664 NAME is name for process. It is modified if necessary to make it unique. 671 NAME is name for process. It is modified if necessary to make it unique.
665 BUFFER is the buffer (or buffer-name) to associate with the process. 672 BUFFER is the buffer (or buffer-name) to associate with the process.
666 Process output goes at end of that buffer, unless you specify 673 Process output goes at end of that buffer, unless you specify
668 BUFFER may also be nil, meaning that this process is not associated 675 BUFFER may also be nil, meaning that this process is not associated
669 with any buffer. 676 with any buffer.
670 Third arg is name of the host to connect to, or its IP address. 677 Third arg is name of the host to connect to, or its IP address.
671 Fourth arg SERVICE is name of the service desired, or an integer 678 Fourth arg SERVICE is name of the service desired, or an integer
672 specifying a port number to connect to. 679 specifying a port number to connect to.
673 Fifth argument FAMILY is a protocol family. When omitted, 'tcp/ip 680 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
674 \(Internet protocol family TCP/IP) is assumed. 681 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
675 */ 682 supported. When omitted, 'tcp is assumed.
676 (name, buffer, host, service, family)) 683
684 Ouput via `process-send-string' and input via buffer or filter (see
685 `set-process-filter') are stream-oriented. That means UDP datagrams are
686 not guaranteed to be sent and received in discrete packets. (But small
687 datagrams around 500 bytes that are not truncated by `process-send-string'
688 are usually fine.) Note further that UDP protocol does not guard against
689 lost packets.
690 */
691 (name, buffer, host, service, protocol))
677 { 692 {
678 /* !!#### This function has not been Mule-ized */ 693 /* !!#### This function has not been Mule-ized */
679 /* This function can GC */ 694 /* This function can GC */
680 Lisp_Object proc = Qnil; 695 Lisp_Object proc = Qnil;
681 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; 696 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
682 void *inch, *outch; 697 void *inch, *outch;
683 698
684 GCPRO5 (name, buffer, host, service, family); 699 GCPRO5 (name, buffer, host, service, protocol);
685 CHECK_STRING (name); 700 CHECK_STRING (name);
686 701
687 if (NILP(family)) 702 if (NILP(protocol))
688 family = Qtcpip; 703 protocol = Qtcp;
689 else 704 else
690 CHECK_SYMBOL (family); 705 CHECK_SYMBOL (protocol);
691 706
692 /* Since this code is inside HAVE_SOCKETS, existence of 707 /* Since this code is inside HAVE_SOCKETS, existence of
693 open_network_stream is mandatory */ 708 open_network_stream is mandatory */
694 PROCMETH (open_network_stream, (name, host, service, family, 709 PROCMETH (open_network_stream, (name, host, service, protocol,
695 &inch, &outch)); 710 &inch, &outch));
696 711
697 if (!NILP (buffer)) 712 if (!NILP (buffer))
698 buffer = Fget_buffer_create (buffer); 713 buffer = Fget_buffer_create (buffer);
699 proc = make_process_internal (name); 714 proc = make_process_internal (name);
713 728
714 #ifdef HAVE_MULTICAST 729 #ifdef HAVE_MULTICAST
715 730
716 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* 731 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
717 Open a multicast connection on the specified dest/port/ttl. 732 Open a multicast connection on the specified dest/port/ttl.
718 Returns a subprocess-object to represent the connection. 733 Return a subprocess-object to represent the connection.
719 Input and output work as for subprocesses; `delete-process' closes it. 734 Input and output work as for subprocesses; `delete-process' closes it.
720 735
721 NAME is name for process. It is modified if necessary to make it unique. 736 NAME is name for process. It is modified if necessary to make it unique.
722 BUFFER is the buffer (or buffer-name) to associate with the process. 737 BUFFER is the buffer (or buffer-name) to associate with the process.
723 Process output goes at end of that buffer, unless you specify 738 Process output goes at end of that buffer, unless you specify
802 { 817 {
803 /* This function can GC */ 818 /* This function can GC */
804 Bytecount nbytes, nchars; 819 Bytecount nbytes, nchars;
805 Bufbyte chars[1024]; 820 Bufbyte chars[1024];
806 Lisp_Object outstream; 821 Lisp_Object outstream;
807 struct Lisp_Process *p = XPROCESS (proc); 822 Lisp_Process *p = XPROCESS (proc);
808 823
809 /* If there is a lot of output from the subprocess, the loop in 824 /* If there is a lot of output from the subprocess, the loop in
810 execute_internal_event() might call read_process_output() more 825 execute_internal_event() might call read_process_output() more
811 than once. If the filter that was executed from one of these 826 than once. If the filter that was executed from one of these
812 calls set the filter to t, we have to stop now. Return -1 rather 827 calls set the filter to t, we have to stop now. Return -1 rather
813 than 0 so execute_internal_event() doesn't close the process. 828 than 0 so execute_internal_event() doesn't close the process.
814 Really, the loop in execute_internal_event() should check itself 829 Really, the loop in execute_internal_event() should check itself
815 for a process-filter change, like in status_notify(); but the 830 for a process-filter change, like in status_notify(); but the
816 struct Lisp_Process is not exported outside of this file. */ 831 struct Lisp_Process is not exported outside of this file. */
817 if (NILP(p->pipe_instream)) 832 if (!PROCESS_LIVE_P (p))
818 return -1; /* already closed */ 833 return -1; /* already closed */
819 834
820 if (!NILP (p->filter) && (p->filter_does_read)) 835 if (!NILP (p->filter) && (p->filter_does_read))
821 { 836 {
822 Lisp_Object filter_result; 837 Lisp_Object filter_result;
947 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer, 962 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer,
948 and in Bytecounts otherwise. */ 963 and in Bytecounts otherwise. */
949 964
950 void 965 void
951 send_process (Lisp_Object proc, 966 send_process (Lisp_Object proc,
952 Lisp_Object relocatable, CONST Bufbyte *nonrelocatable, 967 Lisp_Object relocatable, const Bufbyte *nonrelocatable,
953 int start, int len) 968 int start, int len)
954 { 969 {
955 /* This function can GC */ 970 /* This function can GC */
956 struct gcpro gcpro1, gcpro2; 971 struct gcpro gcpro1, gcpro2;
957 Lisp_Object lstream = Qnil; 972 Lisp_Object lstream = Qnil;
962 signal_simple_error ("Process not open for writing", proc); 977 signal_simple_error ("Process not open for writing", proc);
963 978
964 if (nonrelocatable) 979 if (nonrelocatable)
965 lstream = 980 lstream =
966 make_fixed_buffer_input_stream (nonrelocatable + start, len); 981 make_fixed_buffer_input_stream (nonrelocatable + start, len);
967 else if (GC_BUFFERP (relocatable)) 982 else if (BUFFERP (relocatable))
968 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), 983 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable),
969 start, start + len, 0); 984 start, start + len, 0);
970 else 985 else
971 lstream = make_lisp_string_input_stream (relocatable, start, len); 986 lstream = make_lisp_string_input_stream (relocatable, start, len);
972 987
1021 1036
1022 void 1037 void
1023 set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read) 1038 set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read)
1024 { 1039 {
1025 CHECK_PROCESS (proc); 1040 CHECK_PROCESS (proc);
1026 if (PROCESS_LIVE_P (proc)) { 1041 if (PROCESS_LIVE_P (XPROCESS (proc))) {
1027 if (EQ (filter, Qt)) 1042 if (EQ (filter, Qt))
1028 event_stream_unselect_process (XPROCESS (proc)); 1043 event_stream_unselect_process (XPROCESS (proc));
1029 else 1044 else
1030 event_stream_select_process (XPROCESS (proc)); 1045 event_stream_select_process (XPROCESS (proc));
1031 } 1046 }
1110 Return PROCESS's input coding system. 1125 Return PROCESS's input coding system.
1111 */ 1126 */
1112 (process)) 1127 (process))
1113 { 1128 {
1114 process = get_process (process); 1129 process = get_process (process);
1130 CHECK_LIVE_PROCESS (process);
1115 return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) ); 1131 return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) );
1116 } 1132 }
1117 1133
1118 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* 1134 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /*
1119 Return PROCESS's output coding system. 1135 Return PROCESS's output coding system.
1120 */ 1136 */
1121 (process)) 1137 (process))
1122 { 1138 {
1123 process = get_process (process); 1139 process = get_process (process);
1140 CHECK_LIVE_PROCESS (process);
1124 return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream)); 1141 return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream));
1125 } 1142 }
1126 1143
1127 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* 1144 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /*
1128 Return a pair of coding-system for decoding and encoding of PROCESS. 1145 Return a pair of coding-system for decoding and encoding of PROCESS.
1129 */ 1146 */
1130 (process)) 1147 (process))
1131 { 1148 {
1132 process = get_process (process); 1149 process = get_process (process);
1150 CHECK_LIVE_PROCESS (process);
1133 return Fcons (decoding_stream_coding_system 1151 return Fcons (decoding_stream_coding_system
1134 (XLSTREAM (XPROCESS (process)->coding_instream)), 1152 (XLSTREAM (XPROCESS (process)->coding_instream)),
1135 encoding_stream_coding_system 1153 encoding_stream_coding_system
1136 (XLSTREAM (XPROCESS (process)->coding_outstream))); 1154 (XLSTREAM (XPROCESS (process)->coding_outstream)));
1137 } 1155 }
1142 */ 1160 */
1143 (process, codesys)) 1161 (process, codesys))
1144 { 1162 {
1145 codesys = Fget_coding_system (codesys); 1163 codesys = Fget_coding_system (codesys);
1146 process = get_process (process); 1164 process = get_process (process);
1165 CHECK_LIVE_PROCESS (process);
1166
1147 set_decoding_stream_coding_system 1167 set_decoding_stream_coding_system
1148 (XLSTREAM (XPROCESS (process)->coding_instream), codesys); 1168 (XLSTREAM (XPROCESS (process)->coding_instream), codesys);
1149 return Qnil; 1169 return Qnil;
1150 } 1170 }
1151 1171
1155 */ 1175 */
1156 (process, codesys)) 1176 (process, codesys))
1157 { 1177 {
1158 codesys = Fget_coding_system (codesys); 1178 codesys = Fget_coding_system (codesys);
1159 process = get_process (process); 1179 process = get_process (process);
1180 CHECK_LIVE_PROCESS (process);
1181
1160 set_encoding_stream_coding_system 1182 set_encoding_stream_coding_system
1161 (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); 1183 (XLSTREAM (XPROCESS (process)->coding_outstream), codesys);
1162 return Qnil; 1184 return Qnil;
1163 } 1185 }
1164 1186
1165 DEFUN ("set-process-coding-system", Fset_process_coding_system, 1187 DEFUN ("set-process-coding-system", Fset_process_coding_system,
1166 1, 3, 0, /* 1188 1, 3, 0, /*
1167 Set coding-systems of PROCESS to DECODING and ENCODING. 1189 Set coding-systems of PROCESS to DECODING and ENCODING.
1190 DECODING will be used to decode subprocess output and ENCODING to
1191 encode subprocess input.
1168 */ 1192 */
1169 (process, decoding, encoding)) 1193 (process, decoding, encoding))
1170 { 1194 {
1171 if (!NILP (decoding)) 1195 if (!NILP (decoding))
1172 Fset_process_input_coding_system (process, decoding); 1196 Fset_process_input_coding_system (process, decoding);
1184 /************************************************************************/ 1208 /************************************************************************/
1185 1209
1186 static Lisp_Object 1210 static Lisp_Object
1187 exec_sentinel_unwind (Lisp_Object datum) 1211 exec_sentinel_unwind (Lisp_Object datum)
1188 { 1212 {
1189 struct Lisp_Cons *d = XCONS (datum); 1213 Lisp_Cons *d = XCONS (datum);
1190 XPROCESS (d->car)->sentinel = d->cdr; 1214 XPROCESS (d->car)->sentinel = d->cdr;
1191 free_cons (d); 1215 free_cons (d);
1192 return Qnil; 1216 return Qnil;
1193 } 1217 }
1194 1218
1195 static void 1219 static void
1196 exec_sentinel (Lisp_Object proc, Lisp_Object reason) 1220 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
1197 { 1221 {
1198 /* This function can GC */ 1222 /* This function can GC */
1199 int speccount = specpdl_depth (); 1223 int speccount = specpdl_depth ();
1200 struct Lisp_Process *p = XPROCESS (proc); 1224 Lisp_Process *p = XPROCESS (proc);
1201 Lisp_Object sentinel = p->sentinel; 1225 Lisp_Object sentinel = p->sentinel;
1202 1226
1203 if (NILP (sentinel)) 1227 if (NILP (sentinel))
1204 return; 1228 return;
1205 1229
1240 CHECK_PROCESS (proc); 1264 CHECK_PROCESS (proc);
1241 return XPROCESS (proc)->sentinel; 1265 return XPROCESS (proc)->sentinel;
1242 } 1266 }
1243 1267
1244 1268
1245 CONST char * 1269 const char *
1246 signal_name (int signum) 1270 signal_name (int signum)
1247 { 1271 {
1248 if (signum >= 0 && signum < NSIG) 1272 if (signum >= 0 && signum < NSIG)
1249 return (CONST char *) sys_siglist[signum]; 1273 return (const char *) sys_siglist[signum];
1250 1274
1251 return (CONST char *) GETTEXT ("unknown signal"); 1275 return (const char *) GETTEXT ("unknown signal");
1252 } 1276 }
1253 1277
1254 void 1278 void
1255 update_process_status (Lisp_Object p, 1279 update_process_status (Lisp_Object p,
1256 Lisp_Object status_symbol, 1280 Lisp_Object status_symbol,
1265 } 1289 }
1266 1290
1267 /* Return a string describing a process status list. */ 1291 /* Return a string describing a process status list. */
1268 1292
1269 static Lisp_Object 1293 static Lisp_Object
1270 status_message (struct Lisp_Process *p) 1294 status_message (Lisp_Process *p)
1271 { 1295 {
1272 Lisp_Object symbol = p->status_symbol; 1296 Lisp_Object symbol = p->status_symbol;
1273 int code = p->exit_code; 1297 int code = p->exit_code;
1274 int coredump = p->core_dumped; 1298 int coredump = p->core_dumped;
1275 Lisp_Object string, string2; 1299 Lisp_Object string, string2;
1349 GCPRO3 (tail, symbol, msg); 1373 GCPRO3 (tail, symbol, msg);
1350 1374
1351 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) 1375 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
1352 { 1376 {
1353 Lisp_Object proc = XCAR (tail); 1377 Lisp_Object proc = XCAR (tail);
1354 struct Lisp_Process *p = XPROCESS (proc); 1378 Lisp_Process *p = XPROCESS (proc);
1355 /* p->tick is also volatile. Same thing as above applies. */ 1379 /* p->tick is also volatile. Same thing as above applies. */
1356 int this_process_tick; 1380 int this_process_tick;
1357 1381
1358 /* #### extra check for terminated processes, in case a SIGCHLD 1382 /* #### extra check for terminated processes, in case a SIGCHLD
1359 got missed (this seems to happen sometimes, I'm not sure why). 1383 got missed (this seems to happen sometimes, I'm not sure why).
1516 Lisp_Object proc = get_process (process); 1540 Lisp_Object proc = get_process (process);
1517 1541
1518 if (network_connection_p (proc)) 1542 if (network_connection_p (proc))
1519 error ("Network connection %s is not a subprocess", 1543 error ("Network connection %s is not a subprocess",
1520 XSTRING_DATA (XPROCESS(proc)->name)); 1544 XSTRING_DATA (XPROCESS(proc)->name));
1521 if (!PROCESS_LIVE_P (proc)) 1545 CHECK_LIVE_PROCESS (proc);
1522 error ("Process %s is not active",
1523 XSTRING_DATA (XPROCESS(proc)->name));
1524 1546
1525 MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg)); 1547 MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg));
1526 } 1548 }
1527 1549
1528 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* 1550 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /*
1619 1641
1620 CHECK_SYMBOL (sigcode); 1642 CHECK_SYMBOL (sigcode);
1621 name = string_data (XSYMBOL (sigcode)->name); 1643 name = string_data (XSYMBOL (sigcode)->name);
1622 1644
1623 #define handle_signal(signal) \ 1645 #define handle_signal(signal) \
1624 else if (!strcmp ((CONST char *) name, #signal)) \ 1646 else if (!strcmp ((const char *) name, #signal)) \
1625 XSETINT (sigcode, signal) 1647 XSETINT (sigcode, signal)
1626 1648
1627 if (0) 1649 if (0)
1628 ; 1650 ;
1629 handle_signal (SIGINT); /* ANSI */ 1651 handle_signal (SIGINT); /* ANSI */
1808 /************************************************************************/ 1830 /************************************************************************/
1809 1831
1810 void 1832 void
1811 deactivate_process (Lisp_Object proc) 1833 deactivate_process (Lisp_Object proc)
1812 { 1834 {
1813 struct Lisp_Process *p = XPROCESS (proc); 1835 Lisp_Process *p = XPROCESS (proc);
1814 USID usid; 1836 USID usid;
1815 1837
1816 /* It's possible that we got as far in the process-creation 1838 /* It's possible that we got as far in the process-creation
1817 process as creating the descriptors but didn't get so 1839 process as creating the descriptors but didn't get so
1818 far as selecting the process for input. In this 1840 far as selecting the process for input. In this
1835 else 1857 else
1836 usid = event_stream_delete_stream_pair (p->pipe_instream, 1858 usid = event_stream_delete_stream_pair (p->pipe_instream,
1837 p->pipe_outstream); 1859 p->pipe_outstream);
1838 1860
1839 if (usid != USID_DONTHASH) 1861 if (usid != USID_DONTHASH)
1840 remhash ((CONST void*)usid, usid_to_process); 1862 remhash ((const void*)usid, usid_to_process);
1841 1863
1842 p->pipe_instream = Qnil; 1864 p->pipe_instream = Qnil;
1843 p->pipe_outstream = Qnil; 1865 p->pipe_outstream = Qnil;
1844 #ifdef FILE_CODING 1866 #ifdef FILE_CODING
1845 p->coding_instream = Qnil; 1867 p->coding_instream = Qnil;
1861 PROCESS may be a process or the name of one, or a buffer name. 1883 PROCESS may be a process or the name of one, or a buffer name.
1862 */ 1884 */
1863 (proc)) 1885 (proc))
1864 { 1886 {
1865 /* This function can GC */ 1887 /* This function can GC */
1866 struct Lisp_Process *p; 1888 Lisp_Process *p;
1867 proc = get_process (proc); 1889 proc = get_process (proc);
1868 p = XPROCESS (proc); 1890 p = XPROCESS (proc);
1869 if (network_connection_p (proc)) 1891 if (network_connection_p (proc))
1870 { 1892 {
1871 p->status_symbol = Qexit; 1893 p->status_symbol = Qexit;
1872 p->exit_code = 0; 1894 p->exit_code = 0;
1873 p->core_dumped = 0; 1895 p->core_dumped = 0;
1874 p->tick++; 1896 p->tick++;
1875 process_tick++; 1897 process_tick++;
1876 } 1898 }
1877 else if (!NILP(p->pipe_instream)) 1899 else if (PROCESS_LIVE_P (p))
1878 { 1900 {
1879 Fkill_process (proc, Qnil); 1901 Fkill_process (proc, Qnil);
1880 /* Do this now, since remove_process will make sigchld_handler do nothing. */ 1902 /* Do this now, since remove_process will make sigchld_handler do nothing. */
1881 p->status_symbol = Qsignal; 1903 p->status_symbol = Qsignal;
1882 p->exit_code = SIGKILL; 1904 p->exit_code = SIGKILL;
1895 void 1917 void
1896 kill_buffer_processes (Lisp_Object buffer) 1918 kill_buffer_processes (Lisp_Object buffer)
1897 { 1919 {
1898 Lisp_Object tail; 1920 Lisp_Object tail;
1899 1921
1900 for (tail = Vprocess_list; GC_CONSP (tail); 1922 for (tail = Vprocess_list; CONSP (tail);
1901 tail = XCDR (tail)) 1923 tail = XCDR (tail))
1902 { 1924 {
1903 Lisp_Object proc = XCAR (tail); 1925 Lisp_Object proc = XCAR (tail);
1904 if (GC_PROCESSP (proc) 1926 if (PROCESSP (proc)
1905 && (GC_NILP (buffer) || GC_EQ (XPROCESS (proc)->buffer, buffer))) 1927 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
1906 { 1928 {
1907 if (network_connection_p (proc)) 1929 if (network_connection_p (proc))
1908 Fdelete_process (proc); 1930 Fdelete_process (proc);
1909 else if (!NILP (XPROCESS (proc)->pipe_instream)) 1931 else if (PROCESS_LIVE_P (XPROCESS (proc)))
1910 process_send_signal (proc, SIGHUP, 0, 1); 1932 process_send_signal (proc, SIGHUP, 0, 1);
1911 } 1933 }
1912 } 1934 }
1913 } 1935 }
1914 1936
1967 1989
1968 void 1990 void
1969 syms_of_process (void) 1991 syms_of_process (void)
1970 { 1992 {
1971 defsymbol (&Qprocessp, "processp"); 1993 defsymbol (&Qprocessp, "processp");
1994 defsymbol (&Qprocess_live_p, "process-live-p");
1972 defsymbol (&Qrun, "run"); 1995 defsymbol (&Qrun, "run");
1973 defsymbol (&Qstop, "stop"); 1996 defsymbol (&Qstop, "stop");
1974 defsymbol (&Qopen, "open"); 1997 defsymbol (&Qopen, "open");
1975 defsymbol (&Qclosed, "closed"); 1998 defsymbol (&Qclosed, "closed");
1976 1999
1977 defsymbol (&Qtcpip, "tcp/ip"); 2000 defsymbol (&Qtcp, "tcp");
2001 defsymbol (&Qudp, "udp");
1978 2002
1979 #ifdef HAVE_MULTICAST 2003 #ifdef HAVE_MULTICAST
1980 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ 2004 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */
1981 #endif 2005 #endif
1982 2006
1983 DEFSUBR (Fprocessp); 2007 DEFSUBR (Fprocessp);
2008 DEFSUBR (Fprocess_live_p);
1984 DEFSUBR (Fget_process); 2009 DEFSUBR (Fget_process);
1985 DEFSUBR (Fget_buffer_process); 2010 DEFSUBR (Fget_buffer_process);
1986 DEFSUBR (Fdelete_process); 2011 DEFSUBR (Fdelete_process);
1987 DEFSUBR (Fprocess_status); 2012 DEFSUBR (Fprocess_status);
1988 DEFSUBR (Fprocess_exit_status); 2013 DEFSUBR (Fprocess_exit_status);