/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osproc.h,v 1.2 1991/03/01 00:55:01 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osproc.h,v 1.3 1991/03/09 21:10:45 cph Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
enum process_channel_type channel_err_type,
Tchannel channel_err));
extern void EXFUN (OS_process_deallocate, (Tprocess process));
+
+extern int EXFUN (OS_process_valid_p, (Tprocess process));
+extern int EXFUN (OS_process_continuable_p, (Tprocess process));
+extern int EXFUN (OS_process_foregroundable_p, (Tprocess process));
+
extern pid_t EXFUN (OS_process_id, (Tprocess process));
+extern enum process_jc_status EXFUN (OS_process_jc_status, (Tprocess process));
+extern int EXFUN (OS_process_status_sync, (Tprocess process));
extern enum process_status EXFUN (OS_process_status, (Tprocess process));
extern unsigned short EXFUN (OS_process_reason, (Tprocess process));
-extern enum process_jc_status EXFUN (OS_process_jc_status, (Tprocess process));
+
extern void EXFUN (OS_process_send_signal, (Tprocess process, int sig));
extern void EXFUN (OS_process_kill, (Tprocess process));
extern void EXFUN (OS_process_stop, (Tprocess process));
extern void EXFUN (OS_process_interrupt, (Tprocess process));
extern void EXFUN (OS_process_quit, (Tprocess process));
+
extern void EXFUN (OS_process_continue_background, (Tprocess process));
-extern enum process_status EXFUN
- (OS_process_continue_foreground, (Tprocess process));
-extern enum process_status EXFUN (OS_process_wait, (Tprocess process));
+extern void EXFUN (OS_process_continue_foreground, (Tprocess process));
+extern void EXFUN (OS_process_wait, (Tprocess process));
#endif /* SCM_OSPROC_H */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.5 1991/03/08 19:49:59 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.6 1991/03/09 21:10:50 cph Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
{
Tprocess process =
(arg_index_integer (argument_number, OS_process_table_size));
- switch (OS_process_status (process))
- {
- case process_status_exited:
- case process_status_signalled:
- case process_status_running:
- case process_status_stopped:
- break;
- default:
- error_bad_range_arg (1);
- break;
- }
+ if (! (OS_process_valid_p (process)))
+ error_bad_range_arg (argument_number);
return (process);
}
{
Tprocess process;
for (process = 0; (process < OS_process_table_size); process += 1)
- {
- enum process_status status = (OS_process_status (process));
- if ((status == process_status_running)
- || (status == process_status_stopped)
- || (status == process_status_exited)
- || (status == process_status_signalled))
- obstack_grow ((&scratch_obstack), (&process), (sizeof (Tprocess)));
- }
+ if (OS_process_valid_p (process))
+ obstack_grow ((&scratch_obstack), (&process), (sizeof (Tprocess)));
}
{
unsigned int n_processes =
PRIMITIVE_RETURN (long_to_integer (OS_process_id (arg_process (1))));
}
-static SCHEME_OBJECT
-DEFUN (status_to_object, (status), enum process_status status)
-{
- switch (status)
- {
- case process_status_running:
- return (LONG_TO_UNSIGNED_FIXNUM (0));
- case process_status_stopped:
- return (LONG_TO_UNSIGNED_FIXNUM (1));
- case process_status_exited:
- return (LONG_TO_UNSIGNED_FIXNUM (2));
- case process_status_signalled:
- return (LONG_TO_UNSIGNED_FIXNUM (3));
- default:
- error_bad_range_arg (1);
- return (UNSPECIFIC);
- }
-}
-
-DEFINE_PRIMITIVE ("PROCESS-STATUS", Prim_process_status, 1, 1,
- "Return the status of process PROCESS-NUMBER, a nonnegative integer:\n\
- 0 = running; 1 = stopped; 2 = exited; 3 = signalled.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN
- (status_to_object
- (OS_process_status (arg_index_integer (1, OS_process_table_size))));
-}
-
-DEFINE_PRIMITIVE ("PROCESS-REASON", Prim_process_reason, 1, 1,
- "Return the termination reason of process PROCESS-NUMBER.\n\
-This is a nonnegative integer, which depends on the process's status:\n\
- running => zero;\n\
- stopped => the signal that stopped the process;\n\
- exited => the exit code returned by the process;\n\
- signalled => the signal that killed the process.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (OS_process_reason (arg_process (1))));
-}
-
DEFINE_PRIMITIVE ("PROCESS-JOB-CONTROL-STATUS", Prim_process_jc_status, 1, 1,
"Returns the job-control status of process PROCESS-NUMBER:\n\
0 means this system doesn't support job control.\n\
PRIMITIVE_RETURN (UNSPECIFIC);
}
}
+
+DEFINE_PRIMITIVE ("PROCESS-STATUS-SYNC", Prim_process_status_sync, 1, 1,
+ "Synchronize the status of process PROCESS-NUMBER.\n\
+Return #F if it was previously synchronized, #T if not.")
+{
+ PRIMITIVE_HEADER (1);
+ PRIMITIVE_RETURN
+ (BOOLEAN_TO_OBJECT (OS_process_status_sync (arg_process (1))));
+}
+
+DEFINE_PRIMITIVE ("PROCESS-STATUS", Prim_process_status, 1, 1,
+ "Return the status of process PROCESS-NUMBER, a nonnegative integer:\n\
+ 0 = running; 1 = stopped; 2 = exited; 3 = signalled.\n\
+The value is from the last synchronization.")
+{
+ PRIMITIVE_HEADER (1);
+ switch (OS_process_status (arg_process (1)))
+ {
+ case process_status_running:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (0));
+ case process_status_stopped:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (1));
+ case process_status_exited:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (2));
+ case process_status_signalled:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (3));
+ default:
+ error_external_return ();
+ PRIMITIVE_RETURN (UNSPECIFIC);
+ }
+}
+
+DEFINE_PRIMITIVE ("PROCESS-REASON", Prim_process_reason, 1, 1,
+ "Return the termination reason of process PROCESS-NUMBER.\n\
+This is a nonnegative integer, which depends on the process's status:\n\
+ running => zero;\n\
+ stopped => the signal that stopped the process;\n\
+ exited => the exit code returned by the process;\n\
+ signalled => the signal that killed the process.\n\
+The value is from the last synchronization.")
+{
+ PRIMITIVE_HEADER (1);
+ PRIMITIVE_RETURN (long_to_integer (OS_process_reason (arg_process (1))));
+}
\f
DEFINE_PRIMITIVE ("PROCESS-SIGNAL", Prim_process_signal, 2, 2,
"Send a signal to process PROCESS-NUMBER; second arg SIGNAL says which one.")
DEFINE_PRIMITIVE ("PROCESS-STOP", Prim_process_stop, 1, 1,
"Stops process PROCESS-NUMBER (unix SIGTSTP).")
PROCESS_SIGNALLING_PRIMITIVE (OS_process_stop)
-\f
+
DEFINE_PRIMITIVE ("PROCESS-CONTINUE-BACKGROUND", Prim_process_continue_background, 1, 1,
"Continues process PROCESS-NUMBER in the background.")
{
PRIMITIVE_HEADER (1);
{
Tprocess process = (arg_process (1));
- switch (OS_process_status (process))
- {
- case process_status_stopped:
- case process_status_running:
- break;
- default:
- error_bad_range_arg (1);
- break;
- }
+ if (! (OS_process_continuable_p (process)))
+ error_bad_range_arg (1);
OS_process_continue_background (process);
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
DEFINE_PRIMITIVE ("PROCESS-WAIT", Prim_process_wait, 1, 1,
- "Waits until process PROCESS-NUMBER is not running.\n\
-Returns the process status.")
+ "Waits until process PROCESS-NUMBER is not running.")
{
PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (status_to_object (OS_process_wait (arg_process (1))));
+ OS_process_wait (arg_process (1));
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
DEFINE_PRIMITIVE ("PROCESS-CONTINUE-FOREGROUND", Prim_process_continue_foreground, 1, 1,
"Continues process PROCESS-NUMBER in the foreground.\n\
-The process must have the same controlling terminal as Scheme.\n\
-Returns the process status.")
+The process must have the same controlling terminal as Scheme.")
{
PRIMITIVE_HEADER (1);
{
Tprocess process = (arg_process (1));
- switch (OS_process_jc_status (process))
- {
- case process_jc_status_no_jc:
- case process_jc_status_jc:
- break;
- default:
- error_bad_range_arg (1);
- break;
- }
- switch (OS_process_status (process))
- {
- case process_status_stopped:
- case process_status_running:
- break;
- default:
- error_bad_range_arg (1);
- break;
- }
- PRIMITIVE_RETURN
- (status_to_object (OS_process_continue_foreground (process)));
+ if (! ((OS_process_foregroundable_p (process))
+ && (OS_process_continuable_p (process))))
+ error_bad_range_arg (1);
+ OS_process_continue_foreground (process);
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.7 1991/03/08 19:50:44 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.8 1991/03/09 21:10:57 cph Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
static void EXFUN (stop_signal_handler, (int signo));
static void EXFUN (give_terminal_to, (Tprocess process));
static void EXFUN (get_terminal_back, (void));
-static enum process_status EXFUN (process_wait, (Tprocess process));
+static void EXFUN (process_wait, (Tprocess process));
static int EXFUN (child_setup_tty, (int fd));
size_t OS_process_table_size;
static int scheme_ctty_fd;
static Tprocess foreground_child_process;
+
+static long process_tick;
+
+#define NEW_RAW_STATUS(process, status, reason) \
+{ \
+ (PROCESS_RAW_STATUS (process)) = (status); \
+ (PROCESS_RAW_REASON (process)) = (reason); \
+ (PROCESS_TICK (process)) = (++process_tick); \
+}
+
+#define PROCESS_STATUS_SYNC(process) \
+{ \
+ (PROCESS_STATUS (process)) = (PROCESS_RAW_STATUS (process)); \
+ (PROCESS_REASON (process)) = (PROCESS_RAW_REASON (process)); \
+ (PROCESS_SYNC_TICK (process)) = (PROCESS_TICK (process)); \
+}
\f
/* This macro should only be used when
(scheme_jc_status == process_jc_status_jc). */
foreground_child_process = NO_PROCESS;
subprocess_death_hook = subprocess_death;
stop_signal_hook = stop_signal_handler;
+ process_tick = 0;
}
void
DEFUN (process_allocate_abort, (environment), PTR environment)
{
Tprocess process = (* ((Tprocess *) environment));
- switch (PROCESS_STATUS (process))
+ switch (PROCESS_RAW_STATUS (process))
{
case process_status_stopped:
case process_status_running:
{
Tprocess process;
for (process = 0; (process < OS_process_table_size); process += 1)
- if ((PROCESS_STATUS (process)) == process_status_free)
+ if ((PROCESS_RAW_STATUS (process)) == process_status_free)
{
Tprocess * pp = (dstack_alloc (sizeof (Tprocess)));
(*pp) = process;
transaction_record_action (tat_abort, process_allocate_abort, pp);
- (PROCESS_STATUS (process)) = process_status_allocated;
+ (PROCESS_RAW_STATUS (process)) = process_status_allocated;
return (process);
}
error_out_of_processes ();
DEFUN (OS_process_deallocate, (process), Tprocess process)
{
(PROCESS_ID (process)) = 0;
- (PROCESS_STATUS (process)) = process_status_free;
- (PROCESS_REASON (process)) = 0;
+ (PROCESS_RAW_STATUS (process)) = process_status_free;
}
\f
Tprocess
{
/* In the parent process. */
(PROCESS_ID (child)) = child_pid;
- (PROCESS_STATUS (child)) = process_status_running;
- (PROCESS_REASON (child)) = 0;
(PROCESS_JC_STATUS (child)) = child_jc_status;
+ (PROCESS_RAW_STATUS (child)) = process_status_running;
+ (PROCESS_RAW_REASON (child)) = 0;
+ (PROCESS_TICK (child)) = process_tick;
+ PROCESS_STATUS_SYNC (child);
if (child_jc_status == process_jc_status_jc)
STD_VOID_SYSTEM_CALL
(syscall_setpgid, (UX_setpgid (child_pid, child_pid)));
if (ctty_type == process_ctty_type_inherit_fg)
{
give_terminal_to (child);
- (void) process_wait (child);
+ process_wait (child);
}
transaction_commit ();
return (child);
DEFUN_PROCESS_ACCESSOR
(OS_process_jc_status, enum process_jc_status, PROCESS_JC_STATUS)
+int
+DEFUN (OS_process_valid_p, (process), Tprocess process)
+{
+ switch (PROCESS_RAW_STATUS (process))
+ {
+ case process_status_exited:
+ case process_status_signalled:
+ case process_status_stopped:
+ case process_status_running:
+ return (1);
+ default:
+ return (0);
+ }
+}
+
+int
+DEFUN (OS_process_continuable_p, (process), Tprocess process)
+{
+ switch (PROCESS_RAW_STATUS (process))
+ {
+ case process_status_stopped:
+ case process_status_running:
+ return (1);
+ default:
+ return (0);
+ }
+}
+
+int
+DEFUN (OS_process_foregroundable_p, (process), Tprocess process)
+{
+ switch (PROCESS_JC_STATUS (process))
+ {
+ case process_jc_status_no_jc:
+ case process_jc_status_jc:
+ return (1);
+ default:
+ return (0);
+ }
+}
+
+int
+DEFUN (OS_process_status_sync, (process), Tprocess process)
+{
+ transaction_begin ();
+ block_sigchld ();
+ {
+ int result = ((PROCESS_TICK (process)) != (PROCESS_SYNC_TICK (process)));
+ if (result)
+ PROCESS_STATUS_SYNC (process);
+ transaction_commit ();
+ return (result);
+ }
+}
+\f
void
DEFUN (OS_process_send_signal, (process, sig), Tprocess process AND int sig)
{
{
transaction_begin ();
block_sigchld ();
- if ((PROCESS_STATUS (process)) == process_status_stopped)
+ if ((PROCESS_RAW_STATUS (process)) == process_status_stopped)
{
- (PROCESS_STATUS (process)) = process_status_running;
- (PROCESS_REASON (process)) = 0;
+ NEW_RAW_STATUS (process, process_status_running, 0);
OS_process_send_signal (process, SIGCONT);
}
transaction_commit ();
}
-enum process_status
+void
DEFUN (OS_process_continue_foreground, (process), Tprocess process)
{
transaction_begin ();
grab_signal_mask ();
block_jc_signals ();
give_terminal_to (process);
- if ((PROCESS_STATUS (process)) == process_status_stopped)
+ if ((PROCESS_RAW_STATUS (process)) == process_status_stopped)
{
- (PROCESS_STATUS (process)) = process_status_running;
- (PROCESS_REASON (process)) = 0;
+ NEW_RAW_STATUS (process, process_status_running, 0);
OS_process_send_signal (process, SIGCONT);
}
- {
- enum process_status result = (process_wait (process));
- transaction_commit ();
- return (result);
- }
+ process_wait (process);
+ transaction_commit ();
}
-
-enum process_status
+\f
+void
DEFUN (OS_process_wait, (process), Tprocess process)
{
transaction_begin ();
grab_signal_mask ();
block_jc_signals ();
- {
- enum process_status result = (process_wait (process));
- transaction_commit ();
- return (result);
- }
+ process_wait (process);
+ transaction_commit ();
}
-\f
+
static void
DEFUN (get_terminal_back_1, (environment), PTR environment)
{
}
}
-static enum process_status
+static void
DEFUN (process_wait, (process), Tprocess process)
{
- enum process_status result;
#ifdef HAVE_POSIX_SIGNALS
- while (((result = (PROCESS_STATUS (process))) == process_status_running)
+ while (((PROCESS_RAW_STATUS (process)) == process_status_running)
&& (! (pending_interrupts_p ())))
UX_sigsuspend (&grabbed_signal_mask);
#else /* not HAVE_POSIX_SIGNALS */
- result = (PROCESS_STATUS (process));
- while ((result == process_status_running)
+ enum process_status status = (PROCESS_RAW_STATUS (process));
+ while ((status == process_status_running)
&& (! (pending_interrupts_p ())))
{
/* INTERRUPTABLE_EXTENT eliminates the interrupt window between
- PROCESS_STATUS and `pause'. */
+ PROCESS_RAW_STATUS and `pause'. */
int scr;
INTERRUPTABLE_EXTENT
(scr,
- ((((result = (PROCESS_STATUS (process))) == process_status_running)
+ ((((status = (PROCESS_RAW_STATUS (process)))
+ == process_status_running)
&& (! (pending_interrupts_p ())))
? (UX_pause ())
: ((errno = EINTR), (-1))));
}
#endif /* not HAVE_POSIX_SIGNALS */
- return (result);
}
\f
static Tprocess EXFUN (find_process, (pid_t pid));
{
if (WIFEXITED (*status))
{
- (PROCESS_STATUS (process)) = process_status_exited;
- (PROCESS_REASON (process)) = (WEXITSTATUS (*status));
+ NEW_RAW_STATUS
+ (process, process_status_exited, (WEXITSTATUS (*status)));
}
else if (WIFSTOPPED (*status))
{
- (PROCESS_STATUS (process)) = process_status_stopped;
- (PROCESS_REASON (process)) = (WSTOPSIG (*status));
+ NEW_RAW_STATUS
+ (process, process_status_stopped, (WSTOPSIG (*status)));
}
else if (WIFSIGNALED (*status))
{
- (PROCESS_STATUS (process)) = process_status_signalled;
- (PROCESS_REASON (process)) = (WTERMSIG (*status));
+ NEW_RAW_STATUS
+ (process, process_status_signalled, (WTERMSIG (*status)));
}
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.h,v 1.2 1991/03/01 00:56:15 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.h,v 1.3 1991/03/09 21:11:04 cph Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
struct process
{
pid_t id;
+ long tick;
+ long sync_tick;
+ unsigned short raw_reason;
unsigned short reason;
+ enum process_status raw_status;
enum process_status status;
enum process_jc_status jc_status;
};
#define PROCESS_ID(process) ((process_table [(process)]) . id)
-#define PROCESS_STATUS(process) ((process_table [(process)]) . status)
+#define PROCESS_TICK(process) ((process_table [(process)]) . tick)
+#define PROCESS_SYNC_TICK(process) ((process_table [(process)]) . sync_tick)
+#define PROCESS_RAW_REASON(process) ((process_table [(process)]) . raw_reason)
#define PROCESS_REASON(process) ((process_table [(process)]) . reason)
+#define PROCESS_RAW_STATUS(process) ((process_table [(process)]) . raw_status)
+#define PROCESS_STATUS(process) ((process_table [(process)]) . status)
#define PROCESS_JC_STATUS(process) ((process_table [(process)]) . jc_status)
extern struct process * process_table;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.65 1991/03/08 01:41:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.66 1991/03/09 21:11:10 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 65
+#define SUBVERSION 66
#endif
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.65 1991/03/08 01:41:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.66 1991/03/09 21:11:10 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 65
+#define SUBVERSION 66
#endif
projects / mit-scheme.git / commitdiff