1 /* -*-C-*-
2 
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5     2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6     Institute of Technology
7 
8 This file is part of MIT/GNU Scheme.
9 
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14 
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18 General Public License for more details.
19 
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24 
25 */
26 
27 #include "scheme.h"
28 #include "ux.h"
29 #include "uxproc.h"
30 #include "uxio.h"
31 #include "osterm.h"
32 #include "ostop.h"
33 
34 #ifndef HAVE_DUP2
35 #include "error: can't hack subprocess I/O without dup2() or equivalent"
36 #endif
37 
38 extern void (*subprocess_death_hook) (pid_t pid, int * status);
39 extern void (*stop_signal_hook) (int signo);
40 extern void stop_signal_default (int signo);
41 extern int OS_ctty_fd (void);
42 extern void UX_initialize_child_signals (void);
43 
44 static void subprocess_death (pid_t pid, int * status);
45 static void stop_signal_handler (int signo);
46 static void give_terminal_to (Tprocess process);
47 static void get_terminal_back (void);
48 static void process_wait (Tprocess process);
49 static int child_setup_tty (int fd);
50 
51 Tprocess OS_process_table_size;
52 struct process * process_table;
53 enum process_jc_status scheme_jc_status;
54 
55 static int scheme_ctty_fd;
56 static Tprocess foreground_child_process;
57 
58 static long process_tick;
59 static long sync_tick;
60 
61 #define NEW_RAW_STATUS(process, status, reason) do			\
62 {									\
63   (PROCESS_RAW_STATUS (process)) = (status);				\
64   (PROCESS_RAW_REASON (process)) = (reason);				\
65   (PROCESS_TICK (process)) = (++process_tick);				\
66 } while (0)
67 
68 #define PROCESS_STATUS_SYNC(process) do					\
69 {									\
70   (PROCESS_STATUS (process)) = (PROCESS_RAW_STATUS (process));		\
71   (PROCESS_REASON (process)) = (PROCESS_RAW_REASON (process));		\
72   (PROCESS_SYNC_TICK (process)) = (PROCESS_TICK (process));		\
73 } while (0)
74 
75 /* This macro should only be used when
76    (scheme_jc_status == process_jc_status_jc). */
77 #define SCHEME_IN_FOREGROUND()						\
78   ((UX_tcgetpgrp (scheme_ctty_fd)) == (UX_getpgrp ()))
79 
80 #ifdef HAVE_POSIX_SIGNALS
81 
82 static void
restore_signal_mask(void * environment)83 restore_signal_mask (void * environment)
84 {
85   UX_sigprocmask (SIG_SETMASK, ((sigset_t *) environment), 0);
86 }
87 
88 static void
block_sigchld(void)89 block_sigchld (void)
90 {
91   sigset_t * outside = (dstack_alloc (sizeof (sigset_t)));
92   sigset_t sigchld;
93   UX_sigemptyset (&sigchld);
94   UX_sigaddset ((&sigchld), SIGCHLD);
95   UX_sigprocmask (SIG_BLOCK, (&sigchld), outside);
96   transaction_record_action (tat_always, restore_signal_mask, outside);
97 }
98 
99 static void
block_jc_signals(void)100 block_jc_signals (void)
101 {
102   sigset_t * outside = (dstack_alloc (sizeof (sigset_t)));
103   sigset_t jc_signals;
104   UX_sigemptyset (&jc_signals);
105   UX_sigaddset ((&jc_signals), SIGCHLD);
106   UX_sigaddset ((&jc_signals), SIGTTOU);
107   UX_sigaddset ((&jc_signals), SIGTTIN);
108   UX_sigaddset ((&jc_signals), SIGTSTP);
109   UX_sigaddset ((&jc_signals), SIGSTOP);
110   UX_sigprocmask (SIG_BLOCK, (&jc_signals), outside);
111   transaction_record_action (tat_always, restore_signal_mask, outside);
112 }
113 
114 static sigset_t grabbed_signal_mask;
115 
116 static void
grab_signal_mask(void)117 grab_signal_mask (void)
118 {
119   UX_sigprocmask (SIG_BLOCK, 0, (&grabbed_signal_mask));
120 }
121 
122 #else /* not HAVE_POSIX_SIGNALS */
123 
124 #ifdef HAVE_SIGHOLD
125 
126 static void
release_sigchld(void * environment)127 release_sigchld (void * environment)
128 {
129   UX_sigrelse (SIGCHLD);
130 }
131 
132 static void
block_sigchld(void)133 block_sigchld (void)
134 {
135   UX_sighold (SIGCHLD);
136   transaction_record_action (tat_always, release_sigchld, 0);
137 }
138 
139 #else /* not HAVE_SIGHOLD */
140 
141 #define block_sigchld()
142 
143 #endif /* not HAVE_SIGHOLD */
144 
145 #define block_jc_signals block_sigchld
146 #define grab_signal_mask()
147 
148 #endif /* not HAVE_POSIX_SIGNALS */
149 
150 void
UX_initialize_processes(void)151 UX_initialize_processes (void)
152 {
153   OS_process_table_size = 64;
154   process_table
155     = (UX_malloc (OS_process_table_size * (sizeof (struct process))));
156   if (process_table == 0)
157     {
158       fprintf (stderr, "\nUnable to allocate process table.\n");
159       fflush (stderr);
160       termination_init_error ();
161     }
162   {
163     Tprocess process;
164     for (process = 0; (process < OS_process_table_size); process += 1)
165       OS_process_deallocate (process);
166   }
167   scheme_ctty_fd = (OS_ctty_fd ());
168   scheme_jc_status =
169     ((scheme_ctty_fd < 0)     ? process_jc_status_no_ctty
170      : (UX_SC_JOB_CONTROL ()) ? process_jc_status_jc
171      : /*else*/			process_jc_status_no_jc);
172   foreground_child_process = NO_PROCESS;
173   subprocess_death_hook = subprocess_death;
174   stop_signal_hook = stop_signal_handler;
175   process_tick = 0;
176   sync_tick = 0;
177 }
178 
179 void
UX_reset_processes(void)180 UX_reset_processes (void)
181 {
182   UX_free (process_table);
183   process_table = 0;
184   OS_process_table_size = 0;
185 }
186 
187 static void
process_allocate_abort(void * environment)188 process_allocate_abort (void * environment)
189 {
190   Tprocess process = (* ((Tprocess *) environment));
191   switch (PROCESS_RAW_STATUS (process))
192     {
193     case process_status_stopped:
194     case process_status_running:
195       UX_kill ((PROCESS_ID (process)), SIGKILL);
196       break;
197     default:
198       break;
199     }
200   OS_process_deallocate (process);
201 }
202 
203 static Tprocess
process_allocate(void)204 process_allocate (void)
205 {
206   Tprocess process;
207   for (process = 0; (process < OS_process_table_size); process += 1)
208     if ((PROCESS_RAW_STATUS (process)) == process_status_free)
209       {
210 	(PROCESS_RAW_STATUS (process)) = process_status_allocated;
211 	break;
212       }
213   if (process == OS_process_table_size)
214     {
215       size_t old_size = OS_process_table_size;
216       size_t new_size = ((old_size * 5) / 4);
217       struct process * new_table
218 	= (UX_realloc (process_table, (new_size * (sizeof (struct process)))));
219       if (new_table == 0)
220 	{
221 	  error_out_of_processes ();
222 	  return (NO_PROCESS);
223 	}
224       OS_process_table_size = new_size;
225       process_table = new_table;
226       for (process = old_size; (process < new_size); process += 1)
227 	OS_process_deallocate (process);
228       process = old_size;
229     }
230   {
231     Tprocess * pp = (dstack_alloc (sizeof (Tprocess)));
232     (*pp) = process;
233     transaction_record_action (tat_abort, process_allocate_abort, pp);
234   }
235   return (process);
236 }
237 
238 void
OS_process_deallocate(Tprocess process)239 OS_process_deallocate (Tprocess process)
240 {
241   (PROCESS_ID (process)) = 0;
242   (PROCESS_RAW_STATUS (process)) = process_status_free;
243 }
244 
245 Tprocess
OS_make_subprocess(const char * filename,const char ** argv,const char ** volatile envp,const char * working_directory,enum process_ctty_type ctty_type,char * ctty_name,enum process_channel_type channel_in_type,Tchannel channel_in,enum process_channel_type channel_out_type,Tchannel channel_out,enum process_channel_type channel_err_type,Tchannel channel_err)246 OS_make_subprocess (const char * filename,
247 		    const char ** argv,
248 		    const char ** volatile envp,
249 		    const char * working_directory,
250 		    enum process_ctty_type ctty_type,
251 		    char * ctty_name,
252 		    enum process_channel_type channel_in_type,
253 		    Tchannel channel_in,
254 		    enum process_channel_type channel_out_type,
255 		    Tchannel channel_out,
256 		    enum process_channel_type channel_err_type,
257 		    Tchannel channel_err)
258 {
259   pid_t child_pid;
260   volatile Tprocess child;
261   volatile enum process_jc_status child_jc_status = process_jc_status_no_ctty;
262 
263   if (envp == 0)
264     envp = ((const char **) environ);
265   switch (ctty_type)
266     {
267     case process_ctty_type_none:
268       child_jc_status = process_jc_status_no_ctty;
269       break;
270     case process_ctty_type_explicit:
271       child_jc_status = process_jc_status_unrelated;
272       break;
273     case process_ctty_type_inherit_bg:
274     case process_ctty_type_inherit_fg:
275       child_jc_status = scheme_jc_status;
276       break;
277     }
278 
279   transaction_begin ();
280   child = (process_allocate ());
281   grab_signal_mask ();
282   if (ctty_type == process_ctty_type_inherit_fg)
283     block_jc_signals ();
284   else
285     block_sigchld ();
286   STD_UINT_SYSTEM_CALL (syscall_vfork, child_pid, (UX_vfork ()));
287 
288   if (child_pid > 0)
289     {
290       /* In the parent process. */
291       (PROCESS_ID (child)) = child_pid;
292       (PROCESS_JC_STATUS (child)) = child_jc_status;
293       (PROCESS_RAW_STATUS (child)) = process_status_running;
294       (PROCESS_RAW_REASON (child)) = 0;
295       (PROCESS_TICK (child)) = process_tick;
296       PROCESS_STATUS_SYNC (child);
297 
298       /* If we are doing job control for the child, make sure the child
299 	 is in its own progress group before returning, so that we can
300 	 set the ctty's process group and send job control signals to
301 	 the child.  */
302       if (child_jc_status == process_jc_status_jc)
303 	/* There is a race condition here: see the RATIONALE section of
304     <http://pubs.opengroup.org/onlinepubs/9699919799/functions/setpgid.html>
305 	   (POSIX.1-2008) for details.	The gist is that neither parent
306 	   nor child can rely on the other to set the child's process
307 	   group, so both try it.  It's OK for either the parent or the
308 	   child to lose the race: after calling setpgid, each one
309 	   cares only that the child have its own process group, which
310 	   will be the case irrespective of who wins the race.	If the
311 	   parent loses the race (and the child has already exec'd or
312 	   exited), setpgid here may barf, and there are many ways that
313 	   the parent can lose the race, so we just ignore any failure
314 	   here under the (mildly bogus) assumption that failure means
315 	   losing the race rather than manifesting a bug.  */
316 	(void) UX_setpgid (child_pid, child_pid);
317 
318       if (ctty_type == process_ctty_type_inherit_fg)
319 	{
320 	  give_terminal_to (child);
321 	  process_wait (child);
322 	}
323 
324       transaction_commit ();
325       return (child);
326     }
327 
328   /* In the child process -- if any errors occur, just exit. */
329   child_pid = (UX_getpid ());
330   /* Don't do `transaction_commit ()' here.  Because we used `vfork'
331      to spawn the child, the side-effects that are performed by
332      `transaction_commit' will occur in the parent as well. */
333   if ((working_directory != 0) && ((UX_chdir (working_directory)) < 0))
334     goto kill_child;
335   {
336     int in_fd = (-1);
337     int out_fd = (-1);
338     int err_fd = (-1);
339 
340     if (channel_in_type == process_channel_type_explicit)
341       in_fd = (CHANNEL_DESCRIPTOR (channel_in));
342     if (channel_out_type == process_channel_type_explicit)
343       out_fd = (CHANNEL_DESCRIPTOR (channel_out));
344     if (channel_err_type == process_channel_type_explicit)
345       err_fd = (CHANNEL_DESCRIPTOR (channel_err));
346 
347     if ((ctty_type == process_ctty_type_inherit_bg)
348 	|| (ctty_type == process_ctty_type_inherit_fg))
349       {
350 	/* If the control terminal is inherited and job control is
351 	   available, force the child into a different process group. */
352 	if (child_jc_status == process_jc_status_jc)
353 	  {
354 	    if (((UX_setpgid (child_pid, child_pid)) < 0)
355 		|| ((ctty_type == process_ctty_type_inherit_fg)
356 		    && (SCHEME_IN_FOREGROUND ())
357 		    && ((UX_tcsetpgrp (scheme_ctty_fd, child_pid)) < 0)))
358 	      goto kill_child;
359 	  }
360       }
361     else
362       {
363 	/* If the control terminal is not inherited, force the child
364 	   into a different session. */
365 	if ((UX_setsid ()) < 0)
366 	  goto kill_child;
367 	/* If the control terminal is explicit, open the given device
368 	   now so it becomes the control terminal. */
369 	if (ctty_type == process_ctty_type_explicit)
370 	  {
371 	    int fd = (UX_open (ctty_name, O_RDWR, 0));
372 	    if ((fd < 0)
373 #ifdef SLAVE_PTY_P
374 		|| ((SLAVE_PTY_P (ctty_name)) && (!UX_setup_slave_pty (fd)))
375 #endif
376 		|| (!isatty (fd))
377 #ifdef TIOCSCTTY
378 		|| ((UX_ioctl (fd, TIOCSCTTY, 0)) < 0)
379 #endif
380 		/* Tell the controlling terminal its process group. */
381 		|| (((UX_tcsetpgrp (fd, child_pid)) < 0) && (errno != ENOSYS))
382 		|| ((child_setup_tty (fd)) < 0))
383 	      goto kill_child;
384 	    /* Use CTTY for standard I/O if requested. */
385 	    if (channel_in_type == process_channel_type_ctty)
386 	      in_fd = fd;
387 	    if (channel_out_type == process_channel_type_ctty)
388 	      out_fd = fd;
389 	    if (channel_err_type == process_channel_type_ctty)
390 	      err_fd = fd;
391 	  }
392       }
393 
394     /* Install the new standard I/O channels. */
395     if ((in_fd >= 0) && (in_fd != STDIN_FILENO))
396       {
397 	if ((out_fd == STDIN_FILENO) && ((out_fd = (UX_dup (out_fd))) < 0))
398 	  goto kill_child;
399 	if ((err_fd == STDIN_FILENO) && ((err_fd = (UX_dup (err_fd))) < 0))
400 	  goto kill_child;
401 	if ((UX_dup2 (in_fd, STDIN_FILENO)) < 0)
402 	  goto kill_child;
403       }
404     if ((out_fd >= 0) && (out_fd != STDOUT_FILENO))
405       {
406 	if ((err_fd == STDOUT_FILENO) && ((err_fd = (UX_dup (err_fd))) < 0))
407 	  goto kill_child;
408 	if ((UX_dup2 (out_fd, STDOUT_FILENO)) < 0)
409 	  goto kill_child;
410       }
411     if ((err_fd >= 0) && (err_fd != STDERR_FILENO))
412       {
413 	if ((UX_dup2 (err_fd, STDERR_FILENO)) < 0)
414 	  goto kill_child;
415       }
416   }
417 
418   /* Close all file descriptors not used by the child.  */
419   if (channel_in_type == process_channel_type_none)
420     (void) UX_close (STDIN_FILENO);
421   if (channel_out_type == process_channel_type_none)
422     (void) UX_close (STDOUT_FILENO);
423   if (channel_err_type == process_channel_type_none)
424     (void) UX_close (STDERR_FILENO);
425   /* Assumption: STDIN_FILENO = 0, STDOUT_FILENO = 1, STDERR_FILENO = 2.  */
426   (void) UX_closefrom (3);
427 
428   /* Put the signal mask and handlers in a normal state.  */
429   UX_initialize_child_signals ();
430 
431   /* Start the process. */
432   (void) execve (filename, ((char * const *) argv), ((char * const *) envp));
433  kill_child:
434   _exit (1);
435 }
436 
437 #define DEFUN_PROCESS_ACCESSOR(name, result_type, accessor)		\
438 result_type								\
439 name (Tprocess process)							\
440 {									\
441   return (accessor (process));						\
442 }
443 
DEFUN_PROCESS_ACCESSOR(OS_process_id,pid_t,PROCESS_ID)444 DEFUN_PROCESS_ACCESSOR (OS_process_id, pid_t, PROCESS_ID)
445 DEFUN_PROCESS_ACCESSOR (OS_process_status, enum process_status, PROCESS_STATUS)
446 DEFUN_PROCESS_ACCESSOR (OS_process_reason, unsigned short, PROCESS_REASON)
447 DEFUN_PROCESS_ACCESSOR
448   (OS_process_jc_status, enum process_jc_status, PROCESS_JC_STATUS)
449 
450 int
451 OS_process_valid_p (Tprocess process)
452 {
453   if (process > OS_process_table_size)
454     return (0);
455   switch (PROCESS_RAW_STATUS (process))
456     {
457     case process_status_exited:
458     case process_status_signalled:
459     case process_status_stopped:
460     case process_status_running:
461       return (1);
462     default:
463       return (0);
464     }
465 }
466 
467 int
OS_process_continuable_p(Tprocess process)468 OS_process_continuable_p (Tprocess process)
469 {
470   switch (PROCESS_RAW_STATUS (process))
471     {
472     case process_status_stopped:
473     case process_status_running:
474       return (1);
475     default:
476       return (0);
477     }
478 }
479 
480 int
OS_process_foregroundable_p(Tprocess process)481 OS_process_foregroundable_p (Tprocess process)
482 {
483   switch (PROCESS_JC_STATUS (process))
484     {
485     case process_jc_status_no_jc:
486     case process_jc_status_jc:
487       return (1);
488     default:
489       return (0);
490     }
491 }
492 
493 int
OS_process_status_sync(Tprocess process)494 OS_process_status_sync (Tprocess process)
495 {
496   transaction_begin ();
497   block_sigchld ();
498   {
499     int result = ((PROCESS_TICK (process)) != (PROCESS_SYNC_TICK (process)));
500     if (result) PROCESS_STATUS_SYNC (process);
501     transaction_commit ();
502     return (result);
503   }
504 }
505 
506 int
OS_process_status_sync_all(void)507 OS_process_status_sync_all (void)
508 {
509   transaction_begin ();
510   block_sigchld ();
511   {
512     int result = (process_tick != sync_tick);
513     if (result) sync_tick = process_tick;
514     transaction_commit ();
515     return (result);
516   }
517 }
518 
519 int
OS_process_any_status_change(void)520 OS_process_any_status_change (void)
521 {
522   return (process_tick != sync_tick);
523 }
524 
525 static void
process_send_signal(Tprocess process,int sig)526 process_send_signal (Tprocess process, int sig)
527 {
528   STD_VOID_SYSTEM_CALL
529     (syscall_kill,
530      (UX_kill ((((PROCESS_JC_STATUS (process)) == process_jc_status_jc)
531 		? (- (PROCESS_ID (process)))
532 		: (PROCESS_ID (process))),
533 	       sig)));
534 }
535 
536 void
OS_process_send_signal(Tprocess process,int sig)537 OS_process_send_signal (Tprocess process, int sig)
538 {
539   /* This is hairy because it is not OK to send a signal if the process
540      has already terminated and we have already called wait(2) -- its
541      pid will be recycled, and we might send a signal to some innocent
542      bystander.  So we must guarantee that we won't call wait(2), by
543      blocking SIGCHLD, and check whether the process is in such a state
544      that we can safely signal it.  */
545   transaction_begin ();
546   block_sigchld ();
547   switch (PROCESS_RAW_STATUS (process))
548     {
549     case process_status_running:
550     case process_status_stopped:
551       process_send_signal (process, sig);
552       break;
553 
554     case process_status_exited:
555     case process_status_signalled:
556       /* FIXME: This should signal an error with an argument -- namely,
557 	 with the process index, so that the runtime can do a reverse
558 	 lookup in the subprocess GC finalizer and put the appropriate
559 	 subprocess object in the Scheme error it signals.  */
560       error_process_terminated ();
561 
562       /* The remaining cases shouldn't happen unless there is a bug in
563 	 the runtime; and if so, this is basically like a system call
564 	 error.  */
565     default:
566       error_in_system_call (syserr_no_such_process, syscall_kill);
567     }
568   transaction_commit ();
569 }
570 
571 void
OS_process_kill(Tprocess process)572 OS_process_kill (Tprocess process)
573 {
574   OS_process_send_signal (process, SIGKILL);
575 }
576 
577 void
OS_process_stop(Tprocess process)578 OS_process_stop (Tprocess process)
579 {
580   OS_process_send_signal (process, SIGTSTP);
581 }
582 
583 void
OS_process_interrupt(Tprocess process)584 OS_process_interrupt (Tprocess process)
585 {
586   OS_process_send_signal (process, SIGINT);
587 }
588 
589 void
OS_process_quit(Tprocess process)590 OS_process_quit (Tprocess process)
591 {
592   OS_process_send_signal (process, SIGQUIT);
593 }
594 
595 void
OS_process_hangup(Tprocess process)596 OS_process_hangup (Tprocess process)
597 {
598   OS_process_send_signal (process, SIGHUP);
599 }
600 
601 void
OS_process_continue_background(Tprocess process)602 OS_process_continue_background (Tprocess process)
603 {
604   transaction_begin ();
605   block_sigchld ();
606   if ((PROCESS_RAW_STATUS (process)) == process_status_stopped)
607     {
608       NEW_RAW_STATUS (process, process_status_running, 0);
609       process_send_signal (process, SIGCONT);
610     }
611   transaction_commit ();
612 }
613 
614 void
OS_process_continue_foreground(Tprocess process)615 OS_process_continue_foreground (Tprocess process)
616 {
617   transaction_begin ();
618   grab_signal_mask ();
619   block_jc_signals ();
620   give_terminal_to (process);
621   if ((PROCESS_RAW_STATUS (process)) == process_status_stopped)
622     {
623       NEW_RAW_STATUS (process, process_status_running, 0);
624       process_send_signal (process, SIGCONT);
625     }
626   process_wait (process);
627   transaction_commit ();
628 }
629 
630 void
OS_process_wait(Tprocess process)631 OS_process_wait (Tprocess process)
632 {
633   transaction_begin ();
634   grab_signal_mask ();
635   block_jc_signals ();
636   process_wait (process);
637   transaction_commit ();
638 }
639 
640 static void
get_terminal_back_1(void * environment)641 get_terminal_back_1 (void * environment)
642 {
643   get_terminal_back ();
644 }
645 
646 static void
give_terminal_to(Tprocess process)647 give_terminal_to (Tprocess process)
648 {
649   if (((PROCESS_JC_STATUS (process)) == process_jc_status_jc)
650       && (SCHEME_IN_FOREGROUND ()))
651     {
652       transaction_record_action (tat_always, get_terminal_back_1, 0);
653       foreground_child_process = process;
654       OS_save_internal_state ();
655       OS_restore_external_state ();
656       while ((UX_tcsetpgrp (scheme_ctty_fd, (PROCESS_ID (process)))) < 0)
657 	{
658 	  if (errno == ENOSYS)
659 	    break;
660 	  if (errno != EINTR)
661 	    error_system_call (errno, syscall_tcsetpgrp);
662 	}
663     }
664 }
665 
666 static void
get_terminal_back(void)667 get_terminal_back (void)
668 {
669   if (foreground_child_process != NO_PROCESS)
670     {
671       while ((UX_tcsetpgrp (scheme_ctty_fd, (UX_getpgrp ()))) < 0)
672 	if (errno != EINTR)
673 	  /* We're in no position to signal an error here (inside a
674 	     transaction commit/abort action or a signal handler), so
675 	     just bail.  */
676 	  break;
677       OS_save_external_state ();
678       OS_restore_internal_state ();
679       foreground_child_process = NO_PROCESS;
680     }
681 }
682 
683 static void
process_wait(Tprocess process)684 process_wait (Tprocess process)
685 {
686 #ifdef HAVE_POSIX_SIGNALS
687   while (((PROCESS_RAW_STATUS (process)) == process_status_running)
688 	 && (! (pending_interrupts_p ())))
689     UX_sigsuspend (&grabbed_signal_mask);
690 #else /* not HAVE_POSIX_SIGNALS */
691   enum process_status status = (PROCESS_RAW_STATUS (process));
692   while ((status == process_status_running)
693 	 && (! (pending_interrupts_p ())))
694     {
695       /* INTERRUPTABLE_EXTENT eliminates the interrupt window between
696 	 PROCESS_RAW_STATUS and `pause'. */
697       int scr;
698       INTERRUPTABLE_EXTENT
699 	(scr,
700 	 ((((status = (PROCESS_RAW_STATUS (process)))
701 	    == process_status_running)
702 	   && (! (pending_interrupts_p ())))
703 	  ? (UX_pause ())
704 	  : ((errno = EINTR), (-1))));
705     }
706 #endif /* not HAVE_POSIX_SIGNALS */
707 }
708 
709 static Tprocess
find_process(pid_t pid)710 find_process (pid_t pid)
711 {
712   Tprocess process;
713   for (process = 0; (process < OS_process_table_size); process += 1)
714     if ((PROCESS_ID (process)) == pid)
715       return (process);
716   return (NO_PROCESS);
717 }
718 
719 static void
subprocess_death(pid_t pid,int * status)720 subprocess_death (pid_t pid, int * status)
721 {
722   Tprocess process = (find_process (pid));
723   if (process != NO_PROCESS)
724     {
725       if (WIFEXITED (*status))
726 	NEW_RAW_STATUS
727 	  (process, process_status_exited, (WEXITSTATUS (*status)));
728       else if (WIFSTOPPED (*status))
729 	NEW_RAW_STATUS
730 	  (process, process_status_stopped, (WSTOPSIG (*status)));
731       else if (WIFSIGNALED (*status))
732 	NEW_RAW_STATUS
733 	  (process, process_status_signalled, (WTERMSIG (*status)));
734     }
735 }
736 
737 static void
stop_signal_handler(int signo)738 stop_signal_handler (int signo)
739 {
740   /* If Scheme gets a stop signal while waiting on a foreground
741      subprocess, it must grab the terminal back from the subprocess
742      before stopping.  The caller guarantees that the job-control
743      signals are blocked when this procedure is called. */
744   get_terminal_back ();
745   stop_signal_default (signo);
746 }
747 
748 /* Set up the terminal at the other end of a pseudo-terminal that we
749    will be controlling an inferior through. */
750 
751 #ifdef HAVE_TERMIOS_H
752 
753 /* POSIX.1 doesn't require (or even mention) these symbols, but we
754    must disable them if they are present. */
755 #ifndef IUCLC
756 #  define IUCLC 0
757 #endif
758 #ifndef OLCUC
759 #  define OLCUC 0
760 #endif
761 #ifndef NLDLY
762 #  define NLDLY 0
763 #endif
764 #ifndef CRDLY
765 #  define CRDLY 0
766 #endif
767 #ifndef TABDLY
768 #  define TABDLY 0
769 #endif
770 #ifndef BSDLY
771 #  define BSDLY 0
772 #endif
773 #ifndef VTDLY
774 #  define VTDLY 0
775 #endif
776 #ifndef FFDLY
777 #  define FFDLY 0
778 #endif
779 #ifndef ONLCR
780 #  define ONLCR 0
781 #endif
782 
783 static int
child_setup_tty(int fd)784 child_setup_tty (int fd)
785 {
786   cc_t disabled_char = (UX_PC_VDISABLE (fd));
787   struct termios s;
788   if ((UX_tcgetattr (fd, (&s))) < 0)
789     return (-1);
790   (s . c_iflag) &=~ IUCLC;
791   (s . c_oflag) |= OPOST;
792   (s . c_oflag) &=~
793     (OLCUC | ONLCR | NLDLY | CRDLY | TABDLY | BSDLY | VTDLY | FFDLY);
794   (s . c_lflag) &=~ (ECHO | ECHOE | ECHOK | ECHONL);
795   (s . c_lflag) |= (ICANON | ISIG);
796   ((s . c_cc) [VEOF]) = '\004';
797   ((s . c_cc) [VERASE]) = disabled_char;
798   ((s . c_cc) [VKILL]) = disabled_char;
799   cfsetispeed ((&s), B9600);
800   cfsetospeed ((&s), B9600);
801   return (UX_tcsetattr (fd, TCSADRAIN, (&s)));
802 }
803 
804 #else /* not HAVE_TERMIOS_H */
805 
806 #ifdef HAVE_TERMIO_H
807 
808 static int
child_setup_tty(int fd)809 child_setup_tty (int fd)
810 {
811   cc_t disabled_char = (UX_PC_VDISABLE (fd));
812   struct termio s;
813   if ((ioctl (fd, TCGETA, (&s))) < 0)
814     return (-1);
815   (s . c_iflag) &=~ IUCLC;
816   (s . c_oflag) |= OPOST;
817   (s . c_oflag) &=~
818     (OLCUC | ONLCR | NLDLY | CRDLY | TABDLY | BSDLY | VTDLY | FFDLY);
819   (s . c_lflag) &=~ (ECHO | ECHOE | ECHOK | ECHONL);
820   (s . c_lflag) |= (ICANON | ISIG);
821   ((s . c_cc) [VEOF]) = '\004';
822   ((s . c_cc) [VERASE]) = disabled_char;
823   ((s . c_cc) [VKILL]) = disabled_char;
824   (s . c_cflag) = (((s . c_cflag) &~ CBAUD) | B9600);
825 #ifdef _AIX
826   /* AIX enhanced edit loses NULs, so disable it.
827      Also, PTY overloads NUL and BREAK.
828      don't ignore break, but don't signal either, so it looks like NUL.
829      This really serves a purpose only if running in an XTERM window
830      or via TELNET or the like, but does no harm elsewhere.  */
831   (s . c_line) = 0;
832   (s . c_iflag) &=~ (ASCEDIT | IGNBRK | BRKINT);
833   /* QUIT and INTR work better as signals, so disable character forms */
834   (s . c_lflag) &=~ ISIG;
835   ((s . c_cc) [VQUIT]) = disabled_char;
836   ((s . c_cc) [VINTR]) = disabled_char;
837   ((s . c_cc) [VEOL]) = disabled_char;
838 #endif /* _AIX */
839   return (ioctl (fd, TCSETAW, (&s)));
840 }
841 
842 #else /* not HAVE_TERMIO_H */
843 #ifdef HAVE_SGTTY_H
844 
845 static int
child_setup_tty(int fd)846 child_setup_tty (int fd)
847 {
848   struct sgttyb s;
849   if ((ioctl (fd, TIOCGETP, (&s))) < 0)
850     return (-1);
851   (s . sg_flags) &=~
852     (ECHO | CRMOD | ANYP | ALLDELAY | RAW | LCASE | CBREAK | TANDEM);
853   return (ioctl (fd, TIOCSETN, (&s)));
854 }
855 
856 #endif /* HAVE_SGTTY_H */
857 #endif /* HAVE_TERMIO_H */
858 #endif /* HAVE_TERMIOS_H */
859