/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.39 1990/11/13 08:44:37 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.40 1991/03/01 00:54:24 cph Exp $
-Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
extern void EXFUN (termination_eof, (void));
extern void EXFUN (termination_signal, (CONST char * signal_name));
+extern void EXFUN (Setup_Interrupt, (long Masked_Interrupts));
+extern void EXFUN (preserve_interrupt_mask, (void));
+extern void EXFUN (back_out_of_primitive, (void));
+
extern void
Interpret (),
Do_Micro_Error (),
- Setup_Interrupt (),
- Back_Out_Of_Primitive (),
Translate_To_Point (),
Stop_History (),
Stack_Death ();
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.41 1990/11/14 10:57:22 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.42 1991/03/01 00:54:32 cph Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
} \
/* Put down frames to restore history and interrupts so that these \
operations will be performed on a throw. */ \
- Will_Push (CONTINUATION_SIZE + HISTORY_SIZE); \
- Save_History (return_code); \
- Store_Expression (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK())); \
- Store_Return (RC_RESTORE_INT_MASK); \
- Save_Cont (); \
- Pushed (); \
+ Will_Push (HISTORY_SIZE); \
+ Save_History (return_code); \
+ Pushed (); \
+ preserve_interrupt_mask (); \
/* There is no history to use since the \
last control point was formed. */ \
Prev_Restore_History_Stacklet = NULL; \
/* This is done outside the Will_Push because the space for it
is guaranteed by the interpreter before it gets here.
If done inside, this could break when using stacklets. */
- Back_Out_Of_Primitive ();
- Save_Cont ();
+ back_out_of_primitive ();
Will_Push (HISTORY_SIZE + STACK_ENV_EXTRA_SLOTS + 4);
Stop_History ();
/* Stepping should be cleared here! */
{
long new_mask = (INT_Mask & (arg_integer (1)));
SCHEME_OBJECT thunk = (ARG_REF (2));
- SCHEME_OBJECT old_mask = (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK ()));
POP_PRIMITIVE_FRAME (2);
- Will_Push (CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 2);
- Store_Return (RC_RESTORE_INT_MASK);
- Store_Expression (old_mask);
- Save_Cont ();
- STACK_PUSH (old_mask);
+ preserve_interrupt_mask ();
+ Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
+ STACK_PUSH (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK ()));
STACK_PUSH (thunk);
STACK_PUSH (STACK_FRAME_HEADER + 1);
Pushed ();
PRIMITIVE_CANONICALIZE_CONTEXT();
{
long new_mask = (INT_Mask & (arg_integer (1)));
- SCHEME_OBJECT thunk = (ARG_REF (2));
long old_mask = (FETCH_INTERRUPT_MASK ());
+ SCHEME_OBJECT thunk = (ARG_REF (2));
POP_PRIMITIVE_FRAME (2);
- Will_Push (CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 2);
- Store_Return (RC_RESTORE_INT_MASK);
- Store_Expression (old_mask);
- Save_Cont ();
+ preserve_interrupt_mask ();
+ Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
STACK_PUSH (LONG_TO_FIXNUM (old_mask));
STACK_PUSH (thunk);
STACK_PUSH (STACK_FRAME_HEADER + 1);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.60 1990/11/27 19:13:48 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.61 1991/03/01 00:54:42 cph Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
extern PTR EXFUN (obstack_chunk_alloc, (unsigned int size));
extern void EXFUN (free, (PTR ptr));
#define obstack_chunk_free free
+extern void EXFUN (back_out_of_primitive_internal, (void));
\f
/* In order to make the interpreter tail recursive (i.e.
* to avoid calling procedures and thus saving unnecessary
#define BACK_OUT_AFTER_PRIMITIVE() \
{ \
Export_Registers(); \
- Back_Out_Of_Primitive(); \
+ back_out_of_primitive_internal (); \
Import_Registers(); \
}
\f
DEFUN (abort_to_interpreter, (argument), int argument)
{
interpreter_throw_argument = argument;
- dstack_set_position (interpreter_catch_dstack_position);
+ {
+ long old_mask = IntEnb;
+ IntEnb = 0;
+ dstack_set_position (interpreter_catch_dstack_position);
+ IntEnb = old_mask;
+ }
obstack_free ((&scratch_obstack), 0);
obstack_init (&scratch_obstack);
longjmp (interpreter_catch_env, argument);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osio.h,v 1.5 1990/11/12 04:00:45 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osio.h,v 1.6 1991/03/01 00:54:54 cph Exp $
Copyright (c) 1990 Massachusetts Institute of Technology
(OS_channel_write, (Tchannel channel, CONST PTR buffer, size_t nbytes));
extern void EXFUN
(OS_channel_write_string, (Tchannel channel, CONST char * string));
+extern void EXFUN
+ (OS_make_pipe, (Tchannel * readerp, Tchannel * writerp));
extern int EXFUN (OS_channel_nonblocking_p, (Tchannel channel));
extern void EXFUN (OS_channel_nonblocking, (Tchannel channel));
extern void EXFUN (OS_channel_blocking, (Tchannel channel));
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osproc.h,v 1.1 1990/06/20 19:36:30 cph Rel $
+$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 $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
process_status_signalled /* terminated by being signalled */
};
+enum process_jc_status
+{
+ process_jc_status_no_ctty, /* job has no control terminal */
+ process_jc_status_unrelated, /* job's ctty different from Scheme's */
+ process_jc_status_no_jc, /* job has same ctty, jc not available */
+ process_jc_status_jc /* job has same ctty, jc available */
+};
+
enum process_ctty_type
{
- ctty_type_none, /* no controlling terminal */
- ctty_type_inherited, /* ctty is Scheme's ctty */
- ctty_type_pipe, /* ctty is a pipe */
- ctty_type_pty /* ctty is a PTY */
+ /* No controlling terminal.
+ Used for batch jobs, similar to `nohup' program. */
+ process_ctty_type_none,
+
+ /* Use Scheme's controlling terminal, run in background. */
+ process_ctty_type_inherit_bg,
+
+ /* Use Scheme's controlling terminal, run in foreground. */
+ process_ctty_type_inherit_fg,
+
+ /* Use given controlling terminal, usually a PTY. */
+ process_ctty_type_explicit
+};
+
+enum process_channel_type
+{
+ process_channel_type_none,
+ process_channel_type_inherit,
+ process_channel_type_ctty,
+ process_channel_type_explicit
};
extern size_t OS_process_table_size;
#define NO_PROCESS OS_process_table_size
+extern enum process_jc_status scheme_jc_status;
+
extern Tprocess EXFUN
(OS_make_subprocess,
(CONST char * filename,
CONST char ** argv,
char ** env,
- enum process_ctty_type ctty_type));
+ 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));
extern void EXFUN (OS_process_deallocate, (Tprocess process));
extern pid_t EXFUN (OS_process_id, (Tprocess process));
-extern Tchannel EXFUN (OS_process_input, (Tprocess process));
-extern Tchannel EXFUN (OS_process_output, (Tprocess process));
-extern enum process_ctty_type EXFUN (OS_process_ctty_type, (Tprocess process));
extern enum process_status EXFUN (OS_process_status, (Tprocess process));
extern unsigned short EXFUN (OS_process_reason, (Tprocess process));
-extern int EXFUN (OS_process_synchronous, (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_continue, (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));
#endif /* SCM_OSPROC_H */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osscheme.c,v 1.1 1990/06/20 19:36:32 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osscheme.c,v 1.2 1991/03/01 00:55:11 cph Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
REQUEST_INTERRUPT (INT_Suspend);
}
+int
+DEFUN_VOID (pending_interrupts_p)
+{
+ return (INTERRUPT_PENDING_P (INT_Mask));
+}
+
void
DEFUN_VOID (deliver_pending_interrupts)
{
signal_interrupt_from_primitive ();
}
+long
+DEFUN_VOID (get_interrupt_mask)
+{
+ return (FETCH_INTERRUPT_MASK ());
+}
+
+void
+DEFUN (set_interrupt_mask, (mask), long mask)
+{
+ SET_INTERRUPT_MASK (mask & INT_Mask);
+}
+
void
DEFUN_VOID (debug_back_trace)
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osscheme.h,v 1.2 1990/11/13 08:44:54 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osscheme.h,v 1.3 1991/03/01 00:55:17 cph Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "os.h"
extern Tchannel EXFUN (arg_channel, (int arg_number));
-extern Tchannel EXFUN (arg_channel_old, (int arg_number));
extern int option_emacs_subprocess;
extern void EXFUN (request_timer_interrupt, (void));
extern void EXFUN (request_suspend_interrupt, (void));
extern void EXFUN (deliver_pending_interrupts, (void));
+extern int EXFUN (pending_interrupts_p, (void));
+extern long EXFUN (get_interrupt_mask, (void));
+extern void EXFUN (set_interrupt_mask, (long mask));
+extern void EXFUN (signal_interrupt_for_primitive, (void));
+extern void EXFUN (preserve_interrupt_mask, (void));
+extern void EXFUN (back_out_of_primitive, (void));
#endif /* SCM_OSSCHEME_H */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.37 1990/06/20 17:41:45 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.38 1991/03/01 00:55:21 cph Exp $
-Copyright (c) 1987, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
/* This file contains some macros for defining primitives,
for argument type or value checking, and for accessing
the arguments. */
+
+#include "ansidecl.h"
\f
/* Definition of primitives. */
#define ARG_REF(argument) (STACK_REF (argument - 1))
#define LEXPR_N_ARGUMENTS() (Regs [REGBLOCK_LEXPR_ACTUALS])
\f
-extern void signal_error_from_primitive ();
-extern void signal_interrupt_from_primitive ();
+extern void EXFUN (signal_error_from_primitive, (long error_code));
+extern void EXFUN (signal_interrupt_from_primitive, (void));
extern void error_wrong_type_arg ();
extern void error_bad_range_arg ();
extern void error_external_return ();
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosfile.c,v 1.1 1990/06/20 19:38:21 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosfile.c,v 1.2 1991/03/01 00:55:26 cph Exp $
-Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
}
}
-DEFINE_PRIMITIVE ("FILE-LENGTH", Prim_file_length, 1, 1,
- "Return the length of CHANNEL in characters.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (OS_file_length (arg_channel_old (1))));
-}
-
-DEFINE_PRIMITIVE ("FILE-LENGTH-NEW", Prim_file_length_new, 1, 1,
+DEFINE_PRIMITIVE ("FILE-LENGTH-NEW", Prim_file_length, 1, 1,
"Return the length of CHANNEL in characters.")
{
PRIMITIVE_HEADER (1);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosio.c,v 1.3 1991/01/24 05:30:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosio.c,v 1.4 1991/03/01 00:55:30 cph Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
return (channel);
}
-Tchannel
-DEFUN (arg_channel_old, (arg_number), int arg_number)
-{
- fast SCHEME_OBJECT argument = (ARG_REF (arg_number));
- if ((OBJECT_TYPE (argument)) != TC_HUNK3)
- error_wrong_type_arg (arg_number);
- {
- fast Tchannel channel =
- (arg_to_channel ((MEMORY_REF (argument, 0)), arg_number));
- if (! (OS_channel_open_p (channel)))
- error_bad_range_arg (arg_number);
- return (channel);
- }
-}
-
DEFINE_PRIMITIVE ("CHANNEL-CLOSE", Prim_channel_close, 1, 1,
"Close file CHANNEL-NUMBER.")
{
OS_channel_blocking (arg_channel (1));
PRIMITIVE_RETURN (UNSPECIFIC);
}
+
+DEFINE_PRIMITIVE ("MAKE-PIPE", Prim_make_pipe, 0, 0,
+ "Return a cons of two channels, the reader and writer of a pipe.")
+{
+ PRIMITIVE_HEADER (0);
+ {
+ SCHEME_OBJECT result = (cons (SHARP_F, SHARP_F));
+ Tchannel reader;
+ Tchannel writer;
+ OS_make_pipe ((&reader), (&writer));
+ SET_PAIR_CAR (result, (long_to_integer (reader)));
+ SET_PAIR_CDR (result, (long_to_integer (writer)));
+ PRIMITIVE_RETURN (result);
+ }
+}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.2 1990/11/08 11:04:37 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.3 1991/03/01 00:55:35 cph Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
static int EXFUN (string_vector_p, (SCHEME_OBJECT vector));
static char ** EXFUN (convert_string_vector, (SCHEME_OBJECT vector));
-
+\f
static Tprocess
DEFUN (arg_process, (argument_number), int argument_number)
{
}
return (process);
}
+
+#define PROCESS_CHANNEL_ARG(arg, type, channel) \
+{ \
+ if ((ARG_REF (arg)) == SHARP_F) \
+ (type) = process_channel_type_none; \
+ else if ((ARG_REF (arg)) == (LONG_TO_FIXNUM (-1))) \
+ (type) = process_channel_type_inherit; \
+ else if ((ARG_REF (arg)) == (LONG_TO_FIXNUM (-2))) \
+ { \
+ if (ctty_type != process_ctty_type_explicit) \
+ error_bad_range_arg (arg); \
+ (type) = process_channel_type_ctty; \
+ } \
+ else \
+ { \
+ (type) = process_channel_type_explicit; \
+ (channel) = (arg_channel (arg)); \
+ } \
+}
\f
-DEFINE_PRIMITIVE ("MAKE-SUBPROCESS", Prim_make_subprocess, 4, 4,
+DEFINE_PRIMITIVE ("MAKE-SUBPROCESS", Prim_make_subprocess, 7, 7,
"Create a subprocess.\n\
First arg FILENAME is the program to run.\n\
Second arg ARGV is a vector of strings to pass to the program as arguments.\n\
-Third arg ENV is a vector of strings to pass as the program's environment.\n\
-Fourth arg CTTY-TYPE specifies the program's controlling terminal type:\n\
- 0 => none; 1 => inherited; 2 => pipe; 3 => PTY.")
+Third arg ENV is a vector of strings to pass as the program's environment;\n\
+ #F means inherit Scheme's environment.\n\
+Fourth arg CTTY specifies the program's controlling terminal:\n\
+ #F means none;\n\
+ -1 means use Scheme's controlling terminal in background;\n\
+ -2 means use Scheme's controlling terminal in foreground;\n\
+ string means open that terminal.\n\
+Fifth arg STDIN is the input channel for the subprocess.\n\
+Sixth arg STDOUT is the output channel for the subprocess.\n\
+Seventh arg STDERR is the error channel for the subprocess.\n\
+ Each channel arg can take these values:\n\
+ #F means none;\n\
+ -1 means use the corresponding channel from Scheme;\n\
+ -2 means use the controlling terminal (valid only when CTTY is a string);\n\
+ otherwise the argument must be a channel.")
{
- PRIMITIVE_HEADER (4);
+ PRIMITIVE_HEADER (7);
CHECK_ARG (2, string_vector_p);
if ((ARG_REF (3)) != SHARP_F)
CHECK_ARG (3, string_vector_p);
char ** env =
(((ARG_REF (3)) == SHARP_F) ? 0 : (convert_string_vector (ARG_REF (3))));
enum process_ctty_type ctty_type;
- Tprocess process;
- switch (arg_index_integer (4, 4))
+ char * ctty_name = 0;
+ 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;
+
+ if ((ARG_REF (4)) == SHARP_F)
+ ctty_type = process_ctty_type_none;
+ else if ((ARG_REF (4)) == (LONG_TO_FIXNUM (-1)))
{
- case 0: ctty_type = ctty_type_none; break;
- case 1: ctty_type = ctty_type_inherited; break;
- case 2: ctty_type = ctty_type_pipe; break;
- case 3: ctty_type = ctty_type_pty; break;
+ if (scheme_jc_status == process_jc_status_no_ctty)
+ error_bad_range_arg (4);
+ ctty_type = process_ctty_type_inherit_bg;
}
- process = (OS_make_subprocess (filename, argv, env, ctty_type));
- dstack_set_position (position);
- PRIMITIVE_RETURN (long_to_integer (process));
+ else if ((ARG_REF (4)) == (LONG_TO_FIXNUM (-2)))
+ {
+ if (scheme_jc_status == process_jc_status_no_ctty)
+ error_bad_range_arg (4);
+ ctty_type = process_ctty_type_inherit_fg;
+ }
+ else
+ {
+ ctty_type = process_ctty_type_explicit;
+ ctty_name = (STRING_ARG (4));
+ }
+ PROCESS_CHANNEL_ARG (5, channel_in_type, channel_in);
+ PROCESS_CHANNEL_ARG (6, channel_out_type, channel_out);
+ PROCESS_CHANNEL_ARG (7, channel_err_type, channel_err);
+ {
+ Tprocess process =
+ (OS_make_subprocess
+ (filename, argv, env,
+ ctty_type, ctty_name,
+ channel_in_type, channel_in,
+ channel_out_type, channel_out,
+ channel_err_type, channel_err));
+ dstack_set_position (position);
+ PRIMITIVE_RETURN (long_to_integer (process));
+ }
}
}
-
+\f
static int
DEFUN (string_vector_p, (vector), SCHEME_OBJECT vector)
{
(*scan_result) = 0;
return (result);
}
-\f
+
DEFINE_PRIMITIVE ("SCHEME-ENVIRONMENT", Prim_scheme_environment, 0, 0, 0)
{
PRIMITIVE_HEADER (0);
}
}
}
-
+\f
DEFINE_PRIMITIVE ("PROCESS-DELETE", Prim_process_delete, 1, 1,
"Delete process PROCESS-NUMBER from the process table.\n\
-The process may be deleted only if it is exited or stopped.")
+The process may be deleted only if it is exited or signalled.")
{
PRIMITIVE_HEADER (1);
{
- Tprocess process = (arg_index_integer (1, OS_process_table_size));
- switch (OS_process_status (process))
- {
- case process_status_free:
- break;
- case process_status_allocated:
- case process_status_exited:
- case process_status_signalled:
- OS_process_deallocate (process);
- break;
- case process_status_running:
- case process_status_stopped:
- error_bad_range_arg (1);
- break;
- }
+ Tprocess process = (arg_process (1));
+ enum process_status status = (OS_process_status (process));
+ if (! ((status == process_status_exited)
+ || (status == process_status_signalled)))
+ error_bad_range_arg (1);
+ OS_process_deallocate (process);
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
{
Tprocess process;
for (process = 0; (process < OS_process_table_size); process += 1)
- if ((OS_process_status (process)) != process_status_free)
- obstack_grow ((&scratch_obstack), (&process), (sizeof (Tprocess)));
+ {
+ 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)));
+ }
}
{
unsigned int n_processes =
PRIMITIVE_RETURN (long_to_integer (OS_process_id (arg_process (1))));
}
-DEFINE_PRIMITIVE ("PROCESS-INPUT", Prim_process_input, 1, 1,
- "Return the input channel number of process PROCESS-NUMBER.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (OS_process_input (arg_process (1))));
-}
-
-DEFINE_PRIMITIVE ("PROCESS-OUTPUT", Prim_process_output, 1, 1,
- "Return the output channel number of process PROCESS-NUMBER.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (OS_process_output (arg_process (1))));
-}
-
-DEFINE_PRIMITIVE ("PROCESS-SYNCHRONOUS?", Prim_process_synchronous_p, 1, 1,
- "Return #F iff process PROCESS-NUMBER is not synchronous.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN
- (BOOLEAN_TO_OBJECT (OS_process_synchronous (arg_process (1))));
-}
-
-DEFINE_PRIMITIVE ("PROCESS-CTTY-TYPE", Prim_process_ctty_type, 1, 1,
- "Return the controlling terminal type of process PROCESS-NUMBER.\n\
-This is a nonnegative integer:\n\
- 0 = none; 1 = inherited; 2 = pipe; 3 = PTY.")
+static SCHEME_OBJECT
+DEFUN (status_to_object, (status), enum process_status status)
{
- PRIMITIVE_HEADER (1);
- switch (OS_process_ctty_type (arg_process (1)))
- {
- case ctty_type_none:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (0));
- case ctty_type_inherited:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (1));
- case ctty_type_pipe:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (2));
- case ctty_type_pty:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (3));
- default:
- error_bad_range_arg (1);
- }
-}
-\f
-DEFINE_PRIMITIVE ("PROCESS-STATUS", Prim_process_status, 1, 1,
- "Return the status of process PROCESS-NUMBER.\n\
-This is a nonnegative integer:\n\
- 0 = running; 1 = stopped; 2 = exited; 3 = signalled; 4 = unstarted.")
-{
- PRIMITIVE_HEADER (1);
- switch (OS_process_status (arg_index_integer (1, OS_process_table_size)))
+ switch (status)
{
case process_status_running:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (0));
+ return (LONG_TO_UNSIGNED_FIXNUM (0));
case process_status_stopped:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (1));
+ return (LONG_TO_UNSIGNED_FIXNUM (1));
case process_status_exited:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (2));
+ return (LONG_TO_UNSIGNED_FIXNUM (2));
case process_status_signalled:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (3));
- case process_status_allocated:
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (4));
+ 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\
It is an error if the process is running.\n\
}
}
+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\
+ 1 means the process doesn't have the same controlling terminal as Scheme.\n\
+ 2 means it's the same ctty but the OS doesn't have job control.\n\
+ 3 means it's the same ctty and the OS has job control.")
+{
+ PRIMITIVE_HEADER (1);
+ switch (OS_process_jc_status (arg_process (1)))
+ {
+ case process_jc_status_no_ctty:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (0));
+ case process_jc_status_unrelated:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (1));
+ case process_jc_status_no_jc:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (2));
+ case process_jc_status_jc:
+ PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (3));
+ default:
+ error_bad_range_arg (1);
+ PRIMITIVE_RETURN (UNSPECIFIC);
+ }
+}
+\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-KILL", Prim_process_kill, 1, 1,
- "Kill process PROCESS-NUMBER (in unix: signal SIGKILL).")
+ "Kills process PROCESS-NUMBER (unix SIGKILL).")
PROCESS_SIGNALLING_PRIMITIVE (OS_process_kill)
DEFINE_PRIMITIVE ("PROCESS-INTERRUPT", Prim_process_interrupt, 1, 1,
- "Interrupt process PROCESS-NUMBER (in unix: signal SIGINT).")
+ "Interrupts process PROCESS-NUMBER (unix SIGINT).")
PROCESS_SIGNALLING_PRIMITIVE (OS_process_interrupt)
DEFINE_PRIMITIVE ("PROCESS-QUIT", Prim_process_quit, 1, 1,
- "Quit process PROCESS-NUMBER (in unix: signal SIGQUIT).")
+ "Sends the quit signal to process PROCESS-NUMBER (unix SIGQUIT).")
PROCESS_SIGNALLING_PRIMITIVE (OS_process_quit)
DEFINE_PRIMITIVE ("PROCESS-STOP", Prim_process_stop, 1, 1,
- "Stop process PROCESS-NUMBER (in unix: signal SIGTSTP).")
+ "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;
+ }
+ OS_process_continue_background (process);
+ }
+ PRIMITIVE_RETURN (UNSPECIFIC);
+}
-DEFINE_PRIMITIVE ("PROCESS-CONTINUE", Prim_process_continue, 1, 1,
- "Continue process PROCESS-NUMBER (in unix: signal SIGCONT).")
- PROCESS_SIGNALLING_PRIMITIVE (OS_process_continue)
+DEFINE_PRIMITIVE ("PROCESS-WAIT", Prim_process_wait, 1, 1,
+ "Waits until process PROCESS-NUMBER is not running.\n\
+Returns the process status.")
+{
+ PRIMITIVE_HEADER (1);
+ PRIMITIVE_RETURN (status_to_object (OS_process_wait (arg_process (1))));
+}
+
+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.")
+{
+ 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)));
+ }
+}
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.54 1991/01/24 11:25:15 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.55 1991/03/01 00:55:40 cph Exp $
;;;
;;; Copyright (c) 1987-91 Massachusetts Institute of Technology
;;;
(vector-set! (get-fixed-objects-vector)
#x09 ;(fixed-objects-vector-slot 'SYSTEM-CALL-NAMES)
- #(ACCEPT ;00
- BIND ;01
- CHDIR ;02
- CHMOD ;03
- CLOSE ;04
- CONNECT ;05
- FCNTL-GETFL ;06
- FCNTL-SETFL ;07
- FSTAT ;08
- FTRUNCATE ;09
- GETCWD ;0A
- GETTIMEOFDAY ;0B
- IOCTL-TIOCGPGRP ;0C
- IOCTL-TIOCSIGSEND ;0D
- KILL ;0E
- LINK ;0F
- LISTEN ;10
- LOCALTIME ;11
- LSEEK ;12
- MALLOC ;13
- MKDIR ;14
- OPEN ;15
- OPENDIR ;16
- PIPE ;17
- READ ;18
- READLINK ;19
- REALLOC ;1A
- RENAME ;1B
- SETITIMER ;1C
- SOCKET ;1D
- SYMLINK ;1E
- TCDRAIN ;1F
- TCFLUSH ;20
- TERMINAL-GET-STATE ;21
- TERMINAL-SET-STATE ;22
- TIME ;23
- TIMES ;24
- UNLINK ;25
- VFORK ;26
- WRITE ;27
+ #(ACCEPT
+ BIND
+ CHDIR
+ CHMOD
+ CLOSE
+ CONNECT
+ FCNTL-GETFL
+ FCNTL-SETFL
+ FORK
+ FSTAT
+ FTRUNCATE
+ GETCWD
+ GETTIMEOFDAY
+ IOCTL-TIOCGPGRP
+ IOCTL-TIOCSIGSEND
+ KILL
+ LINK
+ LISTEN
+ LOCALTIME
+ LSEEK
+ MALLOC
+ MKDIR
+ OPEN
+ OPENDIR
+ PAUSE
+ PIPE
+ READ
+ READLINK
+ REALLOC
+ RENAME
+ SETITIMER
+ SETPGID
+ SIGHOLD
+ SIGPROCMASK
+ SIGSUSPEND
+ SLEEP
+ SOCKET
+ SYMLINK
+ TCDRAIN
+ TCFLUSH
+ TCGETPGRP
+ TCSETPGRP
+ TERMINAL-GET-STATE
+ TERMINAL-SET-STATE
+ TIME
+ TIMES
+ UNLINK
+ VFORK
+ WRITE
))
\f
;;; [] System-call errors
;;; This identification string is saved by the system.
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.54 1991/01/24 11:25:15 cph Exp $"
\ No newline at end of file
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.55 1991/03/01 00:55:40 cph Exp $"
\ No newline at end of file
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.48 1991/01/24 11:25:25 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.49 1991/03/01 00:55:47 cph Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
interrupt routines. */
void
-Setup_Interrupt (Masked_Interrupts)
- long Masked_Interrupts;
+DEFUN (Setup_Interrupt, (Masked_Interrupts), long Masked_Interrupts)
{
SCHEME_OBJECT Int_Vector, Handler;
long i, Int_Number, The_Int_Code, New_Int_Enb;
Global_Interrupt_Hook ();
Handler = (VECTOR_REF (Int_Vector, Int_Number));
-/* Setup_Interrupt continues on the next page */
-\f
-/* Setup_Interrupt, continued */
-
Passed_Checks: /* This label may be used in Global_Interrupt_Hook */
Stop_History();
- Will_Push(CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 3);
- /* Return from interrupt handler will re-enable interrupts */
- Store_Return(RC_RESTORE_INT_MASK);
- Store_Expression(LONG_TO_FIXNUM(FETCH_INTERRUPT_MASK()));
- Save_Cont();
+ preserve_interrupt_mask ();
+ Will_Push (STACK_ENV_EXTRA_SLOTS + 3);
/*
There used to be some code here for gc checks, but that is done
uniformly now by RC_NORMAL_GC_DONE.
Pushed();
/* Turn off interrupts */
SET_INTERRUPT_MASK(New_Int_Enb);
- return;
}
\f
/* Error processing utilities */
/*NOTREACHED*/
}
\f
-/* Back_Out_Of_Primitive sets the registers up so that the backout
+void
+DEFUN_VOID (preserve_interrupt_mask)
+{
+ Will_Push (CONTINUATION_SIZE);
+ Store_Return (RC_RESTORE_INT_MASK);
+ Store_Expression (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK ()));
+ Save_Cont ();
+ Pushed ();
+}
+
+/* back_out_of_primitive sets the registers up so that the backout
mechanism in interpret.c will cause the primitive to be
restarted if the error/interrupt is proceeded. */
void
-Back_Out_Of_Primitive ()
+DEFUN_VOID (back_out_of_primitive_internal)
{
long nargs;
SCHEME_OBJECT primitive;
if (! (PRIMITIVE_P (primitive)))
{
fprintf (stderr,
- "\nBack_Out_Of_Primitive backing out when not in primitive!\n");
+ "\nback_out_of_primitive backing out when not in primitive!\n");
Microcode_Termination (TERM_BAD_BACK_OUT);
}
nargs = (PRIMITIVE_N_ARGUMENTS (primitive));
Store_Return (RC_INTERNAL_APPLY);
Store_Expression (SHARP_F);
(Regs [REGBLOCK_PRIMITIVE]) = SHARP_F;
- return;
+}
+
+void
+DEFUN_VOID (back_out_of_primitive)
+{
+ back_out_of_primitive_internal ();
+ Save_Cont ();
}
\f
/* canonicalize_primitive_context should be used by "unsafe" primitives
invoked from compiled code. */
void
-signal_error_from_primitive (error_code)
- long error_code;
+DEFUN (signal_error_from_primitive, (error_code), long error_code)
{
PRIMITIVE_ABORT (error_code);
/*NOTREACHED*/
}
void
-signal_interrupt_from_primitive ()
+DEFUN_VOID (signal_interrupt_from_primitive)
{
PRIMITIVE_ABORT (PRIM_INTERRUPT);
/*NOTREACHED*/
Save_Cont();
Pushed();
}
- Will_Push(STACK_ENV_EXTRA_SLOTS + 3 +
- 2 * CONTINUATION_SIZE +
- HISTORY_SIZE +
- (From_Pop_Return ? 0 : 1));
+ Will_Push (CONTINUATION_SIZE + (From_Pop_Return ? 0 : 1));
if (From_Pop_Return)
{
Store_Expression(Val);
{
STACK_PUSH (Fetch_Env());
}
-
Store_Return((From_Pop_Return) ?
RC_POP_RETURN_ERROR :
RC_EVAL_ERROR);
Save_Cont();
+ Pushed ();
/* Return from error handler will re-enable interrupts & restore history */
-
Stop_History();
- Store_Return(RC_RESTORE_INT_MASK);
- Store_Expression(LONG_TO_FIXNUM(FETCH_INTERRUPT_MASK()));
- Save_Cont();
+ preserve_interrupt_mask ();
+
+ Will_Push (STACK_ENV_EXTRA_SLOTS + 3);
/* Arg 2: Int. mask */
STACK_PUSH (LONG_TO_FIXNUM(FETCH_INTERRUPT_MASK()));
/* Arg 1: Err. No */
}
#endif /* ENABLE_DEBUGGING_TOOLS */
- Will_Push(2*CONTINUATION_SIZE + 4);
- Store_Return(RC_RESTORE_INT_MASK);
- Store_Expression(LONG_TO_FIXNUM(FETCH_INTERRUPT_MASK()));
- Save_Cont();
+ preserve_interrupt_mask ();
+ Will_Push(CONTINUATION_SIZE + 4);
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM((Distance - Merge_Depth)));
STACK_PUSH (Target);
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM((From_Depth - Merge_Depth)));
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.c,v 1.6 1991/01/24 11:25:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.c,v 1.7 1991/03/01 00:55:53 cph Exp $
Copyright (c) 1990-1 Massachusetts Institute of Technology
deliver_pending_interrupts ();
}
-
#ifdef HAVE_TERMIOS
int
DEFUN (UX_tcgetpgrp, (fd), int fd)
{
pid_t pgrp_id;
- int result = (UX_ioctl (fd, TIOCGPGRP, (&pgrp_id)));
- return ((result < 0) ? result : pgrp_id);
+ return (((UX_ioctl (fd, TIOCGPGRP, (&pgrp_id))) < 0) ? (-1) : pgrp_id);
}
int
}
#endif /* _POSIX */
+\f
+#ifndef _POSIX
+
+int
+DEFUN (UX_sigemptyset, (set), sigset_t * set)
+{
+ (*set) = 0;
+ return (0);
+}
+
+int
+DEFUN (UX_sigfillset, (set), sigset_t * set)
+{
+ (*set) = (-1);
+ return (0);
+}
+
+int
+DEFUN (UX_sigaddset, (set, signo), sigset_t * set AND int signo)
+{
+ if (signo <= 0)
+ return (-1);
+ {
+ int mask = (1 << (signo - 1));
+ if (mask == 0)
+ return (-1);
+ (*set) |= mask;
+ return (0);
+ }
+}
+
+int
+DEFUN (UX_sigdelset, (set, signo), sigset_t * set AND int signo)
+{
+ if (signo <= 0)
+ return (-1);
+ {
+ int mask = (1 << (signo - 1));
+ if (mask == 0)
+ return (-1);
+ (*set) &=~ mask;
+ return (0);
+ }
+}
+
+int
+DEFUN (UX_sigismember, (set, signo), CONST sigset_t * set AND int signo)
+{
+ if (signo <= 0)
+ return (-1);
+ {
+ int mask = (1 << (signo - 1));
+ if (mask == 0)
+ return (-1);
+ return (((*set) & mask) != 0);
+ }
+}
+\f
+#ifdef HAVE_BSD_SIGNALS
+
+#ifdef _HPUX
+#define UX_sigvec sigvector
+#else
+#define UX_sigvec sigvec
+#endif
+
+int
+DEFUN (UX_sigaction, (signo, act, oact),
+ int signo AND
+ CONST struct sigaction * act AND
+ struct sigaction * oact)
+{
+ struct sigvec svec;
+ struct sigvec sovec;
+ struct sigvec * vec = ((act != 0) ? (&svec) : 0);
+ struct sigvec * ovec = ((oact != 0) ? (&sovec) : 0);
+ if (act != 0)
+ {
+ (vec -> sv_handler) = (act -> sa_handler);
+ (vec -> sv_mask) = (act -> sa_mask);
+ /* Ignore SA_NOCLDSTOP since we won't use it. */
+ (vec -> sv_flags) = 0;
+ }
+ if ((UX_sigvec (signo, vec, ovec)) < 0)
+ return (-1);
+ if (oact != 0)
+ {
+ (oact -> sa_handler) = (ovec -> sv_handler);
+ (oact -> sa_mask) = (ovec -> sv_mask);
+ (oact -> sa_flags) = 0;
+ }
+ return (0);
+}
+
+int
+DEFUN (UX_sigprocmask, (how, set, oset),
+ int how AND
+ CONST sigset_t * set AND
+ sigset_t * oset)
+{
+ long omask;
+ if (set == 0)
+ omask = (sigblock (0));
+ else
+ switch (how)
+ {
+ case SIG_BLOCK:
+ omask = (sigblock (*set));
+ break;
+ case SIG_UNBLOCK:
+ omask = (sigblock (0));
+ if (omask < 0) return (-1);
+ omask = (sigsetmask (omask &~ (*set)));
+ break;
+ case SIG_SETMASK:
+ omask = (sigsetmask (*set));
+ break;
+ default:
+ errno = EINVAL;
+ return (-1);
+ }
+ if (omask < 0) return (-1);
+ if (oset != 0) (*oset) = omask;
+ return (0);
+}
+
+int
+DEFUN (UX_sigsuspend, (set), CONST sigset_t * set)
+{
+ return (sigpause (*set));
+}
+
+#endif /* HAVE_BSD_SIGNALS */
+#endif /* not _POSIX */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.h,v 1.20 1991/01/24 11:25:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.h,v 1.21 1991/03/01 00:55:57 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
syscall_connect,
syscall_fcntl_GETFL,
syscall_fcntl_SETFL,
+ syscall_fork,
syscall_fstat,
syscall_ftruncate,
syscall_getcwd,
syscall_mkdir,
syscall_open,
syscall_opendir,
+ syscall_pause,
syscall_pipe,
syscall_read,
syscall_readlink,
syscall_realloc,
syscall_rename,
syscall_setitimer,
+ syscall_setpgid,
+ syscall_sighold,
+ syscall_sigprocmask,
+ syscall_sigsuspend,
+ syscall_sleep,
syscall_socket,
syscall_symlink,
syscall_tcdrain,
syscall_tcflush,
+ syscall_tcgetpgrp,
+ syscall_tcsetpgrp,
syscall_terminal_get_state,
syscall_terminal_set_state,
syscall_time,
#endif /* UNION_WAIT_STATUS */
\f
+/* Provide null defaults for all the signals we're likely to use so we
+ aren't continually testing to see if they're defined. */
+
+#ifndef SIGLOST
+#define SIGLOST 0
+#endif
+#ifndef SIGWINCH
+#define SIGWINCH 0
+#endif
+#ifndef SIGURG
+#define SIGURG 0
+#endif
+#ifndef SIGIO
+#define SIGIO 0
+#endif
+#ifndef SIGUSR1
+#define SIGUSR1 0
+#endif
+#ifndef SIGUSR2
+#define SIGUSR2 0
+#endif
+#ifndef SIGVTALRM
+#define SIGVTALRM 0
+#endif
+#ifndef SIGABRT
+#define SIGABRT 0
+#endif
+#ifndef SIGPWR
+#define SIGPWR 0
+#endif
+#ifndef SIGPROF
+#define SIGPROF 0
+#endif
+#ifndef SIGSTOP
+#define SIGSTOP 0
+#endif
+#ifndef SIGTSTP
+#define SIGTSTP 0
+#endif
+#ifndef SIGCONT
+#define SIGCONT 0
+#endif
+#ifndef SIGCHLD
+#define SIGCHLD 0
+#endif
+#ifndef SIGTTIN
+#define SIGTTIN 0
+#endif
+#ifndef SIGTTOU
+#define SIGTTOU 0
+#endif
+\f
/* constants for access() */
#ifndef R_OK
#define R_OK 4
#define UX_chmod chmod
#define UX_close close
#define UX_ctime ctime
+#define UX_dup dup
#define UX_free free
#define UX_fstat fstat
#define UX_getenv getenv
#define UX_lseek lseek
#define UX_malloc malloc
#define UX_mknod mknod
+#define UX_pause pause
#define UX_pipe pipe
#define UX_read read
#define UX_realloc realloc
#define UX_signal signal
+#define UX_sleep sleep
#define UX_stat stat
#define UX_system system
#define UX_time time
#define UX_sigprocmask sigprocmask
#else /* not HAVE_POSIX_SIGNALS */
+
+typedef long sigset_t;
+extern int EXFUN (UX_sigemptyset, (sigset_t * set));
+extern int EXFUN (UX_sigfillset, (sigset_t * set));
+extern int EXFUN (UX_sigaddset, (sigset_t * set, int signo));
+extern int EXFUN (UX_sigdelset, (sigset_t * set, int signo));
+extern int EXFUN (UX_sigismember, (CONST sigset_t * set, int signo));
+
#ifdef HAVE_BSD_SIGNALS
-#ifdef _HPUX
-#define UX_sigvec sigvector
-#else
-#define UX_sigvec sigvec
-#endif
-#define UX_sigblock sigblock
-#define UX_sigsetmask sigsetmask
-#define UX_sigpause sigpause
+struct sigaction
+{
+ Tsignal_handler sa_handler;
+ sigset_t sa_mask;
+ int sa_flags;
+};
+
+extern int EXFUN
+ (UX_sigaction,
+ (int signo, CONST struct sigaction * act, struct sigaction * oact));
+extern int EXFUN
+ (UX_sigprocmask, (int how, CONST sigset_t * set, sigset_t * oset));
+extern int EXFUN (UX_sigsuspend, (CONST sigset_t * set));
+#define SIG_BLOCK 0
+#define SIG_UNBLOCK 1
+#define SIG_SETMASK 2
+
+#define HAVE_POSIX_SIGNALS
#else /* not HAVE_BSD_SIGNALS */
#ifdef HAVE_SYSV3_SIGNALS
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxctty.c,v 1.6 1991/01/07 23:57:07 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxctty.c,v 1.7 1991/03/01 00:56:02 cph Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
{
return ((ctty_fildes >= 0) ? (UX_PC_VDISABLE (ctty_fildes)) : '\377');
}
+
+int
+DEFUN_VOID (OS_ctty_fd)
+{
+ return (ctty_fildes);
+}
\f
#if 0
/* not currently used */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.c,v 1.8 1991/01/24 11:25:55 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.c,v 1.9 1991/03/01 00:56:07 cph Exp $
Copyright (c) 1990-1 Massachusetts Institute of Technology
if ((OS_channel_write (channel, string, length)) != length)
error_external_return ();
}
+
+void
+DEFUN (OS_make_pipe, (readerp, writerp),
+ Tchannel * readerp AND
+ Tchannel * writerp)
+{
+ int pv [2];
+ transaction_begin ();
+ STD_VOID_SYSTEM_CALL (syscall_pipe, (UX_pipe (pv)));
+ MAKE_CHANNEL ((pv[0]), channel_type_pipe, (*readerp) =);
+ OS_channel_close_on_abort (*readerp);
+ MAKE_CHANNEL ((pv[1]), channel_type_pipe, (*writerp) =);
+ transaction_commit ();
+}
\f
#ifdef FCNTL_NONBLOCK
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.4 1991/01/24 11:26:00 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.5 1991/03/01 00:56:10 cph Exp $
-Copyright (c) 1990-1 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "uxio.h"
#include "osterm.h"
+#ifndef HAVE_DUP2
+#include "error: can't hack subprocess I/O without dup2() or equivalent"
+#endif
+
extern char ** environ;
+extern void EXFUN
+ ((*subprocess_death_hook), (pid_t pid, wait_status_t * status));
+extern void EXFUN ((*stop_signal_hook), (int signo));
+extern void EXFUN (stop_signal_default, (int signo));
+extern int EXFUN (OS_ctty_fd, (void));
-static void EXFUN (deallocate_uncommitted_processes, (PTR ignore));
static void EXFUN (subprocess_death, (pid_t pid, wait_status_t * status));
-static Tprocess EXFUN (find_process, (pid_t pid));
-static int EXFUN (child_setup_tty, (Tchannel channel));
-\f
+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 int EXFUN (child_setup_tty, (int fd));
+
size_t OS_process_table_size;
struct process * process_table;
+enum process_jc_status scheme_jc_status;
+
+static int scheme_ctty_fd;
+static Tprocess foreground_child_process;
+\f
+/* This macro should only be used when
+ (scheme_jc_status == process_jc_status_jc). */
+#define SCHEME_IN_FOREGROUND() \
+ ((UX_tcgetpgrp (scheme_ctty_fd)) == (UX_getpgrp ()))
+
+#ifdef HAVE_POSIX_SIGNALS
+
+static void
+DEFUN (restore_signal_mask, (environment), PTR environment)
+{
+ UX_sigprocmask (SIG_SETMASK, ((sigset_t *) environment), 0);
+}
+
+static void
+DEFUN_VOID (block_sigchld)
+{
+ sigset_t * outside = (dstack_alloc (sizeof (sigset_t)));
+ sigset_t sigchld;
+ UX_sigemptyset (&sigchld);
+ UX_sigaddset ((&sigchld), SIGCHLD);
+ UX_sigprocmask (SIG_BLOCK, (&sigchld), outside);
+ transaction_record_action (tat_always, restore_signal_mask, outside);
+}
+
+static void
+DEFUN_VOID (block_jc_signals)
+{
+ sigset_t * outside = (dstack_alloc (sizeof (sigset_t)));
+ sigset_t jc_signals;
+ UX_sigemptyset (&jc_signals);
+ UX_sigaddset ((&jc_signals), SIGCHLD);
+ UX_sigaddset ((&jc_signals), SIGTTOU);
+ UX_sigaddset ((&jc_signals), SIGTTIN);
+ UX_sigaddset ((&jc_signals), SIGTSTP);
+ UX_sigaddset ((&jc_signals), SIGSTOP);
+ UX_sigprocmask (SIG_BLOCK, (&jc_signals), outside);
+ transaction_record_action (tat_always, restore_signal_mask, outside);
+}
+
+static sigset_t grabbed_signal_mask;
+
+static void
+DEFUN_VOID (grab_signal_mask)
+{
+ UX_sigprocmask (SIG_BLOCK, 0, (&grabbed_signal_mask));
+}
+
+#else /* not HAVE_POSIX_SIGNALS */
+
+#ifdef HAVE_SYSV3_SIGNALS
+static void
+DEFUN (release_sigchld, (environment), PTR environment)
+{
+ UX_sigrelse (SIGCHLD);
+}
+
+static void
+DEFUN_VOID (block_sigchld)
+{
+ UX_sighold (SIGCHLD);
+ transaction_record_action (tat_always, release_sigchld, 0);
+}
+
+#endif /* HAVE_SYSV3_SIGNALS */
+
+#define block_jc_signals block_sigchld
+#define grab_signal_mask()
+
+#endif /* not HAVE_POSIX_SIGNALS */
+\f
void
DEFUN_VOID (UX_initialize_processes)
{
{
Tprocess process;
for (process = 0; (process < OS_process_table_size); process += 1)
- (PROCESS_STATUS (process)) = process_status_free;
- }
- {
- extern void EXFUN
- ((*subprocess_death_hook), (pid_t pid, wait_status_t * status));
- subprocess_death_hook = subprocess_death;
+ OS_process_deallocate (process);
}
+ scheme_ctty_fd = (OS_ctty_fd ());
+ scheme_jc_status =
+ ((scheme_ctty_fd < 0)
+ ? process_jc_status_no_ctty
+ : (UX_SC_JOB_CONTROL ())
+ ? process_jc_status_jc
+ : process_jc_status_no_jc);
+ foreground_child_process = NO_PROCESS;
+ subprocess_death_hook = subprocess_death;
+ stop_signal_hook = stop_signal_handler;
}
void
OS_process_table_size = 0;
}
+static void
+DEFUN (process_allocate_abort, (environment), PTR environment)
+{
+ Tprocess process = (* ((Tprocess *) environment));
+ switch (PROCESS_STATUS (process))
+ {
+ case process_status_stopped:
+ case process_status_running:
+ UX_kill ((PROCESS_ID (process)), SIGKILL);
+ break;
+ }
+ OS_process_deallocate (process);
+}
+
static Tprocess
DEFUN_VOID (process_allocate)
{
for (process = 0; (process < OS_process_table_size); process += 1)
if ((PROCESS_STATUS (process)) == process_status_free)
{
- transaction_record_action
- (tat_abort, deallocate_uncommitted_processes, 0);
+ Tprocess * pp = (dstack_alloc (sizeof (Tprocess)));
+ (*pp) = process;
+ transaction_record_action (tat_abort, process_allocate_abort, pp);
(PROCESS_STATUS (process)) = process_status_allocated;
return (process);
}
return (NO_PROCESS);
}
-static void
-DEFUN (deallocate_uncommitted_processes, (ignore), PTR ignore)
-{
- Tprocess process;
- for (process = 0; (process < OS_process_table_size); process += 1)
- if ((PROCESS_STATUS (process)) == process_status_allocated)
- (PROCESS_STATUS (process)) = process_status_free;
-}
-
void
DEFUN (OS_process_deallocate, (process), Tprocess process)
{
(PROCESS_STATUS (process)) = process_status_free;
+ (PROCESS_ID (process)) = 0;
}
\f
Tprocess
-DEFUN (OS_make_subprocess, (filename, argv, envp, ctty_type),
+DEFUN (OS_make_subprocess,
+ (filename, argv, envp,
+ ctty_type, ctty_name,
+ channel_in_type, channel_in,
+ channel_out_type, channel_out,
+ channel_err_type, channel_err),
CONST char * filename AND
CONST char ** argv AND
char ** envp AND
- enum process_ctty_type ctty_type)
+ enum process_ctty_type ctty_type AND
+ char * ctty_name AND
+ enum process_channel_type channel_in_type AND
+ Tchannel channel_in AND
+ enum process_channel_type channel_out_type AND
+ Tchannel channel_out AND
+ enum process_channel_type channel_err_type AND
+ Tchannel channel_err)
{
- Tchannel child_read;
- Tchannel child_write;
- Tchannel parent_read;
- Tchannel parent_write;
pid_t child_pid;
-#ifdef HAVE_PTYS
- CONST char * pty_name;
-#endif
Tprocess child;
-
- if ((ctty_type == ctty_type_none) || (ctty_type == ctty_type_inherited))
- /* Implement shell-like subprocess control later. */
- error_unimplemented_primitive ();
+ enum process_jc_status child_jc_status;
if (envp == 0)
envp = environ;
+ switch (ctty_type)
+ {
+ case process_ctty_type_none:
+ child_jc_status = process_jc_status_no_ctty;
+ break;
+ case process_ctty_type_explicit:
+ child_jc_status = process_jc_status_unrelated;
+ break;
+ case process_ctty_type_inherit_bg:
+ case process_ctty_type_inherit_fg:
+ child_jc_status = scheme_jc_status;
+ break;
+ }
transaction_begin ();
child = (process_allocate ());
- if (ctty_type == ctty_type_pty)
- {
-#ifdef HAVE_PTYS
- {
- CONST char * master_name;
- pty_name = (OS_open_pty_master ((&parent_read), (&master_name)));
- }
- if (pty_name != 0)
- {
- OS_channel_close_on_abort (parent_read);
- parent_write = parent_read;
- }
- else
-#endif /* HAVE_PTYS */
- ctty_type = ctty_type_pipe;
- }
- if (ctty_type == ctty_type_pipe)
- {
- int pv [2];
- STD_VOID_SYSTEM_CALL (syscall_pipe, (UX_pipe (pv)));
- MAKE_CHANNEL ((pv[0]), channel_type_pipe, child_read =);
- OS_channel_close_on_abort (child_read);
- MAKE_CHANNEL ((pv[1]), channel_type_pipe, parent_write =);
- OS_channel_close_on_abort (parent_write);
- STD_VOID_SYSTEM_CALL (syscall_pipe, (UX_pipe (pv)));
- MAKE_CHANNEL ((pv[0]), channel_type_pipe, parent_read =);
- OS_channel_close_on_abort (parent_read);
- MAKE_CHANNEL ((pv[1]), channel_type_pipe, child_write =);
- OS_channel_close_on_abort (child_write);
- }
-
/* Flush streams so that i/o won't be duplicated after the fork */
fflush (stdin);
fflush (stdout);
fflush (stderr);
+ grab_signal_mask ();
+ if (ctty_type == process_ctty_type_inherit_fg)
+ block_jc_signals ();
+ else
+ block_sigchld ();
STD_UINT_SYSTEM_CALL (syscall_vfork, child_pid, (UX_vfork ()));
if (child_pid > 0)
{
/* In the parent process. */
(PROCESS_ID (child)) = child_pid;
- (PROCESS_INPUT (child)) = parent_write;
- (PROCESS_OUTPUT (child)) = parent_read;
(PROCESS_STATUS (child)) = process_status_running;
- (PROCESS_CTTY_TYPE (child)) = ctty_type;
- (PROCESS_CHANGED (child)) = 0;
- (PROCESS_SYNCHRONOUS (child)) = 0;
- if (ctty_type == ctty_type_pipe)
+ (PROCESS_JC_STATUS (child)) = child_jc_status;
+ 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)
{
- /* If either of these closes signals an error, ignore it. */
- UX_close (CHANNEL_DESCRIPTOR (child_read));
- MARK_CHANNEL_CLOSED (child_read);
- UX_close (CHANNEL_DESCRIPTOR (child_write));
- MARK_CHANNEL_CLOSED (child_write);
+ give_terminal_to (child);
+ (void) process_wait (child);
}
transaction_commit ();
return (child);
}
- else
- {
- /* In the child process -- if any errors occur, just exit. */
-
- /* Force child into different session. */
- if ((UX_setsid ()) < 0)
- goto kill_child;
-
-#ifdef HAVE_PTYS
- /* If connection is a PTY, open the slave side (which becomes
- the controlling terminal). */
- if (ctty_type == ctty_type_pty)
- {
- int fd = (UX_open (pty_name, O_RDWR, 0));
- if (fd < 0)
- goto kill_child;
- MAKE_CHANNEL (fd, channel_type_terminal, child_read =);
- child_write = child_read;
- if ((child_setup_tty (child_read)) < 0)
- goto kill_child;
- }
-#endif /* HAVE_PTYS */
-
-#ifdef HAVE_DUP2
- /* Setup the standard I/O for the child. */
- if (((UX_dup2 ((CHANNEL_DESCRIPTOR (child_read)), STDIN_FILENO)) < 0)
- || ((UX_dup2 ((CHANNEL_DESCRIPTOR (child_write)), STDOUT_FILENO))
- < 0)
- || ((UX_dup2 ((CHANNEL_DESCRIPTOR (child_write)), STDERR_FILENO))
- < 0))
- goto kill_child;
-#else
-#include "error: can't hack subprocess I/O without dup2() or equivalent"
-#endif
-
- /* Close all other file descriptors. */
+ /* In the child process -- if any errors occur, just exit. */
+ /* Don't do `transaction_commit ()' here. Because we used `vfork'
+ to spawn the child, the side-effects that are performed by
+ `transaction_commit' will occur in the parent as well. */
+ {
+ int in_fd = (-1);
+ int out_fd = (-1);
+ int err_fd = (-1);
+
+ if (channel_in_type == process_channel_type_explicit)
+ in_fd = (CHANNEL_DESCRIPTOR (channel_in));
+ if (channel_out_type == process_channel_type_explicit)
+ out_fd = (CHANNEL_DESCRIPTOR (channel_out));
+ if (channel_err_type == process_channel_type_explicit)
+ err_fd = (CHANNEL_DESCRIPTOR (channel_err));
+
+ if ((ctty_type == process_ctty_type_inherit_bg)
+ || (ctty_type == process_ctty_type_inherit_fg))
{
- int fd = 0;
- int open_max = (UX_SC_OPEN_MAX ());
- while (fd < open_max)
+ /* If the control terminal is inherited and job control is
+ available, force the child into a different process group. */
+ if (child_jc_status == process_jc_status_jc)
{
- if (! ((fd == STDIN_FILENO) ||
- (fd == STDOUT_FILENO) ||
- (fd == STDERR_FILENO)))
- UX_close (fd);
- fd += 1;
+ pid_t child_pid = (UX_getpid ());
+ if (((UX_setpgid (child_pid, child_pid)) < 0)
+ || ((ctty_type == process_ctty_type_inherit_fg)
+ && (SCHEME_IN_FOREGROUND ())
+ && ((UX_tcsetpgrp (scheme_ctty_fd, child_pid)) < 0)))
+ goto kill_child;
}
}
-
- /* Force the signal mask to be empty.
- (This should be done for HAVE_SYSV3_SIGNALS too, but
- it's more difficult in that case.) */
-#ifdef HAVE_POSIX_SIGNALS
+ else
{
- sigset_t empty_mask;
- UX_sigemptyset (&empty_mask);
- UX_sigprocmask (SIG_SETMASK, (&empty_mask), 0);
+ /* If the control terminal is not inherited, force the child
+ into a different session. */
+ if ((UX_setsid ()) < 0)
+ goto kill_child;
+ /* If the control terminal is explicit, open the given device
+ now so it becomes the control terminal. */
+ if (ctty_type == process_ctty_type_explicit)
+ {
+ int fd = (UX_open (ctty_name, O_RDWR, 0));
+ if ((fd < 0)
+ || (! (isatty (fd)))
+ || ((child_setup_tty (fd)) < 0))
+ goto kill_child;
+ /* Use CTTY for standard I/O if requested. */
+ if (channel_in_type == process_channel_type_ctty)
+ in_fd = fd;
+ if (channel_out_type == process_channel_type_ctty)
+ out_fd = fd;
+ if (channel_err_type == process_channel_type_ctty)
+ err_fd = fd;
+ }
}
-#else /* not HAVE_POSIX_SIGNALS */
-#ifdef HAVE_BSD_SIGNALS
- UX_sigsetmask (0);
-#endif /* HAVE_BSD_SIGNALS */
-#endif /* HAVE_POSIX_SIGNALS */
-
- /* Start the process. */
- execve (filename, argv, envp);
- kill_child:
- _exit (1);
- }
-}
-\f
-static void
-DEFUN (subprocess_death, (pid, status), pid_t pid AND wait_status_t * status)
-{
- Tprocess process = (find_process (pid));
- if (process != NO_PROCESS)
- {
- if (WIFEXITED (*status))
- {
- (PROCESS_CHANGED (process)) = 1;
- (PROCESS_STATUS (process)) = process_status_exited;
- (PROCESS_REASON (process)) = (WEXITSTATUS (*status));
- }
- else if (WIFSTOPPED (*status))
- {
- (PROCESS_CHANGED (process)) = 1;
- (PROCESS_STATUS (process)) = process_status_stopped;
- (PROCESS_REASON (process)) = (WSTOPSIG (*status));
- if (PROCESS_SYNCHRONOUS (process))
- UX_kill (pid, SIGKILL);
- }
- else if (WIFSIGNALED (*status))
- {
- (PROCESS_CHANGED (process)) = 1;
- (PROCESS_STATUS (process)) = process_status_signalled;
- (PROCESS_REASON (process)) = (WTERMSIG (*status));
- }
- }
-}
-static Tprocess
-DEFUN (find_process, (pid), pid_t pid)
-{
- Tprocess process;
- for (process = 0; (process < OS_process_table_size); process += 1)
- if ((PROCESS_ID (process)) == pid)
+ /* Install the new standard I/O channels. */
+ if ((in_fd >= 0) && (in_fd != STDIN_FILENO))
{
- if (((PROCESS_STATUS (process)) == process_status_free)
- || ((PROCESS_STATUS (process)) == process_status_allocated))
- break;
- return (process);
+ if ((out_fd == STDIN_FILENO) && ((out_fd = (UX_dup (out_fd))) < 0))
+ goto kill_child;
+ if ((err_fd == STDIN_FILENO) && ((err_fd = (UX_dup (err_fd))) < 0))
+ goto kill_child;
+ if ((UX_dup2 (in_fd, STDIN_FILENO)) < 0)
+ goto kill_child;
}
- return (NO_PROCESS);
-}
+ if ((out_fd >= 0) && (out_fd != STDOUT_FILENO))
+ {
+ if ((err_fd == STDOUT_FILENO) && ((err_fd = (UX_dup (err_fd))) < 0))
+ goto kill_child;
+ if ((UX_dup2 (out_fd, STDOUT_FILENO)) < 0)
+ goto kill_child;
+ }
+ if ((err_fd >= 0) && (err_fd != STDERR_FILENO))
+ {
+ if ((UX_dup2 (err_fd, STDERR_FILENO)) < 0)
+ goto kill_child;
+ }
+ }
+ {
+ /* Close all other file descriptors. */
+ int fd = 0;
+ int open_max = (UX_SC_OPEN_MAX ());
+ while (fd < open_max)
+ {
+ if ((fd == STDIN_FILENO)
+ ? (channel_in_type == process_channel_type_none)
+ : (fd == STDOUT_FILENO)
+ ? (channel_out_type == process_channel_type_none)
+ : (fd == STDERR_FILENO)
+ ? (channel_err_type == process_channel_type_none)
+ : 1)
+ UX_close (fd);
+ fd += 1;
+ }
+ }
+
+ /* Force the signal mask to be empty. */
+#ifdef HAVE_POSIX_SIGNALS
+ {
+ sigset_t empty_mask;
+ UX_sigemptyset (&empty_mask);
+ UX_sigprocmask (SIG_SETMASK, (&empty_mask), 0);
+ }
+#else
+#ifdef HAVE_SYSV3_SIGNALS
+ /* We could do something more here, but it is hard to enumerate all
+ the possible signals. Instead, just release SIGCHLD, which we
+ know was held above before the child was spawned. */
+ UX_sigrelse (SIGCHLD);
+#endif
+#endif
+ /* Start the process. */
+ execve (filename, argv, envp);
+ kill_child:
+ _exit (1);
+}
+\f
#define DEFUN_PROCESS_ACCESSOR(name, result_type, accessor) \
result_type \
DEFUN (name, (process), Tprocess process) \
DEFUN_PROCESS_ACCESSOR (OS_process_id, pid_t, PROCESS_ID)
DEFUN_PROCESS_ACCESSOR (OS_process_status, enum process_status, PROCESS_STATUS)
-DEFUN_PROCESS_ACCESSOR
- (OS_process_ctty_type, enum process_ctty_type, PROCESS_CTTY_TYPE)
DEFUN_PROCESS_ACCESSOR (OS_process_reason, unsigned short, PROCESS_REASON)
-DEFUN_PROCESS_ACCESSOR (OS_process_synchronous, int, PROCESS_SYNCHRONOUS)
-
-Tchannel
-DEFUN (OS_process_input, (process), Tprocess process)
-{
- Tchannel channel = (PROCESS_INPUT (process));
- if (channel == NO_CHANNEL)
- error_external_return ();
- return (channel);
-}
+DEFUN_PROCESS_ACCESSOR
+ (OS_process_jc_status, enum process_jc_status, PROCESS_JC_STATUS)
-Tchannel
-DEFUN (OS_process_output, (process), Tprocess process)
-{
- Tchannel channel = (PROCESS_OUTPUT (process));
- if (channel == NO_CHANNEL)
- error_external_return ();
- return (channel);
-}
-\f
void
DEFUN (OS_process_send_signal, (process, sig), Tprocess process AND int sig)
{
- STD_VOID_SYSTEM_CALL (syscall_kill, (UX_kill ((PROCESS_ID (process)), sig)));
+ STD_VOID_SYSTEM_CALL
+ (syscall_kill,
+ (UX_kill ((((PROCESS_JC_STATUS (process)) == process_jc_status_jc)
+ ? (- (PROCESS_ID (process)))
+ : (PROCESS_ID (process))),
+ sig)));
}
void
OS_process_send_signal (process, SIGTSTP);
}
-void
-DEFUN (OS_process_continue, (process), Tprocess process)
-{
- OS_process_send_signal (process, SIGCONT);
-}
-
void
DEFUN (OS_process_interrupt, (process), Tprocess process)
{
{
OS_process_send_signal (process, SIGQUIT);
}
+
+void
+DEFUN (OS_process_continue_background, (process), Tprocess process)
+{
+ transaction_begin ();
+ block_sigchld ();
+ if ((PROCESS_STATUS (process)) == process_status_stopped)
+ {
+ (PROCESS_STATUS (process)) = process_status_running;
+ OS_process_send_signal (process, SIGCONT);
+ }
+ transaction_commit ();
+}
+
+enum process_status
+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)
+ {
+ (PROCESS_STATUS (process)) = process_status_running;
+ OS_process_send_signal (process, SIGCONT);
+ }
+ {
+ enum process_status result = (process_wait (process));
+ transaction_commit ();
+ return (result);
+ }
+}
+
+enum process_status
+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);
+ }
+}
\f
-#ifdef HAVE_PTYS
+static void
+DEFUN (get_terminal_back_1, (environment), PTR environment)
+{
+ get_terminal_back ();
+}
+static void
+DEFUN (give_terminal_to, (process), Tprocess process)
+{
+ if (((PROCESS_JC_STATUS (process)) == process_jc_status_jc)
+ && (SCHEME_IN_FOREGROUND ()))
+ {
+ transaction_record_action (tat_always, get_terminal_back_1, 0);
+ foreground_child_process = process;
+ OS_save_internal_state ();
+ OS_restore_external_state ();
+ UX_tcsetpgrp (scheme_ctty_fd, (PROCESS_ID (process)));
+ }
+}
+
+static void
+DEFUN_VOID (get_terminal_back)
+{
+ if (foreground_child_process != NO_PROCESS)
+ {
+ UX_tcsetpgrp (scheme_ctty_fd, (UX_getpgrp ()));
+ OS_save_external_state ();
+ OS_restore_internal_state ();
+ foreground_child_process = NO_PROCESS;
+ }
+}
+
+static enum process_status
+DEFUN (process_wait, (process), Tprocess process)
+{
+ enum process_status result;
+#ifdef HAVE_POSIX_SIGNALS
+ while (((result = (PROCESS_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)
+ && (! (pending_interrupts_p ())))
+ {
+ /* INTERRUPTABLE_EXTENT eliminates the interrupt window between
+ PROCESS_STATUS and `pause'. */
+ int scr;
+ INTERRUPTABLE_EXTENT
+ (scr,
+ ((((result = (PROCESS_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));
+
+static void
+DEFUN (subprocess_death, (pid, status), pid_t pid AND wait_status_t * status)
+{
+ Tprocess process = (find_process (pid));
+ if (process != NO_PROCESS)
+ {
+ if (WIFEXITED (*status))
+ {
+ (PROCESS_STATUS (process)) = process_status_exited;
+ (PROCESS_REASON (process)) = (WEXITSTATUS (*status));
+ }
+ else if (WIFSTOPPED (*status))
+ {
+ (PROCESS_STATUS (process)) = process_status_stopped;
+ (PROCESS_REASON (process)) = (WSTOPSIG (*status));
+ }
+ else if (WIFSIGNALED (*status))
+ {
+ (PROCESS_STATUS (process)) = process_status_signalled;
+ (PROCESS_REASON (process)) = (WTERMSIG (*status));
+ }
+ }
+}
+
+static Tprocess
+DEFUN (find_process, (pid), pid_t pid)
+{
+ Tprocess process;
+ for (process = 0; (process < OS_process_table_size); process += 1)
+ if ((PROCESS_ID (process)) == pid)
+ return (process);
+ return (NO_PROCESS);
+}
+
+static void
+DEFUN (stop_signal_handler, (signo), int signo)
+{
+ /* If Scheme gets a stop signal while waiting on a foreground
+ subprocess, it must grab the terminal back from the subprocess
+ before stopping. The caller guarantees that the job-control
+ signals are blocked when this procedure is called. */
+ get_terminal_back ();
+ stop_signal_default (signo);
+}
+\f
/* Set up the terminal at the other end of a pseudo-terminal that we
will be controlling an inferior through. */
#endif
static int
-DEFUN (child_setup_tty, (channel), Tchannel channel)
+DEFUN (child_setup_tty, (fd), int fd)
{
- int fd = (CHANNEL_DESCRIPTOR (channel));
cc_t disabled_char = (UX_PC_VDISABLE (fd));
struct termios s;
if ((UX_tcgetattr (fd, (&s))) < 0)
}
#else /* not HAVE_TERMIOS */
-\f
+
#ifdef HAVE_TERMIO
static int
-DEFUN (child_setup_tty, (channel), Tchannel channel)
+DEFUN (child_setup_tty, (fd), int fd)
{
- int fd = (CHANNEL_DESCRIPTOR (channel));
cc_t disabled_char = (UX_PC_VDISABLE (fd));
struct termio s;
if ((ioctl (fd, TCGETA, (&s))) < 0)
#ifdef HAVE_BSD_TTY_DRIVER
static int
-DEFUN (child_setup_tty, (channel), Tchannel channel)
+DEFUN (child_setup_tty, (fd), int fd)
{
- int fd = (CHANNEL_DESCRIPTOR (channel));
struct sgttyb s;
if ((ioctl (fd, TIOCGETP, (&s))) < 0)
return (-1);
#endif /* HAVE_BSD_TTY_DRIVER */
#endif /* HAVE_TERMIO */
#endif /* HAVE_TERMIOS */
-#endif /* HAVE_PTYS */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.h,v 1.1 1990/06/20 19:37:25 cph Rel $
+$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 $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
struct process
{
- pid_t id; /* process id */
- Tchannel input; /* standard input */
- Tchannel output; /* standard output and error */
+ pid_t id;
unsigned short reason;
enum process_status status;
- enum process_ctty_type ctty_type;
- unsigned int changed : 1;
- unsigned int synchronous : 1;
+ enum process_jc_status jc_status;
};
#define PROCESS_ID(process) ((process_table [(process)]) . id)
-#define PROCESS_INPUT(process) ((process_table [(process)]) . input)
-#define PROCESS_OUTPUT(process) ((process_table [(process)]) . output)
#define PROCESS_STATUS(process) ((process_table [(process)]) . status)
-#define PROCESS_CTTY_TYPE(process) ((process_table [(process)]) . ctty_type)
#define PROCESS_REASON(process) ((process_table [(process)]) . reason)
-#define PROCESS_CHANGED(process) ((process_table [(process)]) . changed)
-#define PROCESS_SYNCHRONOUS(process) \
- ((process_table [(process)]) . synchronous)
+#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/uxsig.c,v 1.6 1990/11/20 22:17:34 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxsig.c,v 1.7 1991/03/01 00:56:19 cph Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
UX_sigaction (signo, (&act), 0);
}
-#define BLOCK_SIGNALS_DECLARE() sigset_t BLOCK_SIGNALS_mask
-
-#define BLOCK_SIGNALS(signo) \
-{ \
- sigset_t BLOCK_SIGNALS_set; \
- UX_sigfillset (&BLOCK_SIGNALS_set); \
- UX_sigdelset ((&BLOCK_SIGNALS_set), (signo)); \
- UX_sigprocmask \
- (SIG_SETMASK, (&BLOCK_SIGNALS_set), (&BLOCK_SIGNALS_mask)); \
-}
-
-#define UNBLOCK_SIGNALS() \
- UX_sigprocmask (SIG_SETMASK, (&BLOCK_SIGNALS_mask), 0)
-
#else /* not HAVE_POSIX_SIGNALS */
-#ifdef HAVE_BSD_SIGNALS
-
-static Tsignal_handler
-DEFUN (current_handler, (signo), int signo)
-{
- struct sigvec act;
- UX_sigvec (signo, 0, (&act));
- return (act . sv_handler);
-}
-
-static void
-DEFUN (INSTALL_HANDLER, (signo, handler),
- int signo AND
- Tsignal_handler handler)
-{
- struct sigvec act;
- (act . sv_handler) = handler;
- (act . sv_mask) = (1 << (signo - 1));
- (act . sv_flags) = 0;
- UX_sigvec (signo, (&act), 0);
-}
-
-#define BLOCK_SIGNALS_DECLARE() int BLOCK_SIGNALS_mask
-
-#define BLOCK_SIGNALS(signo) \
-{ \
- BLOCK_SIGNALS_mask = (UX_sigblock (0)); \
- UX_sigsetmask (~ (1 << ((signo) - 1))); \
-}
-
-#define UNBLOCK_SIGNALS() UX_sigsetmask (BLOCK_SIGNALS_mask)
-\f
-#else /* not HAVE_BSD_SIGNALS */
#ifdef HAVE_SYSV3_SIGNALS
static Tsignal_handler
}
#define INSTALL_HANDLER UX_sigset
-#define BLOCK_SIGNALS_DECLARE() int BLOCK_SIGNALS_mask
-#define BLOCK_SIGNALS(signo) UX_sigrelse (signo)
-#define UNBLOCK_SIGNALS()
#define NEED_HANDLER_TRANSACTION
#define ENTER_HANDLER(signo)
}
#define INSTALL_HANDLER UX_signal
-#define BLOCK_SIGNALS_DECLARE() int BLOCK_SIGNALS_mask
-#define BLOCK_SIGNALS(signo)
-#define UNBLOCK_SIGNALS()
#define NEED_HANDLER_TRANSACTION
#define ENTER_HANDLER(signo) UX_signal ((signo), SIG_IGN)
#define EXIT_HANDLER UX_signal
#endif /* HAVE_SYSV3_SIGNALS */
-#endif /* HAVE_BSD_SIGNALS */
#endif /* HAVE_POSIX_SIGNALS */
\f
/* Signal Descriptors */
#endif /* _BSD */
#endif /* _HPUX */
-/* Provide null defaults for all the signals we're likely to use so we
- aren't continually testing to see if they're defined. */
-
#if (SIGABRT == SIGIOT)
#undef SIGABRT
-#endif
-
-#ifndef SIGLOST
-#define SIGLOST 0
-#endif
-#ifndef SIGWINCH
-#define SIGWINCH 0
-#endif
-#ifndef SIGURG
-#define SIGURG 0
-#endif
-#ifndef SIGIO
-#define SIGIO 0
-#endif
-#ifndef SIGUSR1
-#define SIGUSR1 0
-#endif
-#ifndef SIGUSR2
-#define SIGUSR2 0
-#endif
-#ifndef SIGVTALRM
-#define SIGVTALRM 0
-#endif
-#ifndef SIGABRT
#define SIGABRT 0
#endif
-#ifndef SIGPWR
-#define SIGPWR 0
-#endif
-#ifndef SIGPROF
-#define SIGPROF 0
-#endif
-#ifndef SIGSTOP
-#define SIGSTOP 0
-#endif
-#ifndef SIGTSTP
-#define SIGTSTP 0
-#endif
-#ifndef SIGCONT
-#define SIGCONT 0
-#endif
-#ifndef SIGCHLD
-#define SIGCHLD 0
-#endif
-#ifndef SIGTTIN
-#define SIGTTIN 0
-#endif
-#ifndef SIGTTOU
-#define SIGTTOU 0
-#endif
-\f
+
static void
DEFUN_VOID (initialize_signal_descriptors)
{
DEFUN_STD_HANDLER (sighnd_interactive,
(interactive_interrupt_handler (scp)))
-static void
-DEFUN (restartable_exit, (signo), int signo)
+void
+DEFUN (stop_signal_default, (signo), int signo)
{
- if (UX_SC_JOB_CONTROL ())
- {
- BLOCK_SIGNALS_DECLARE ();
- BLOCK_SIGNALS (signo);
- OS_save_internal_state ();
- OS_restore_external_state ();
- {
- Tsignal_handler handler = (current_handler (signo));
- INSTALL_HANDLER (signo, SIG_DFL);
- UX_kill ((UX_getpid ()), signo);
- INSTALL_HANDLER (signo, handler);
- }
- OS_save_external_state ();
- OS_restore_internal_state ();
- UNBLOCK_SIGNALS ();
- }
+#ifdef HAVE_POSIX_SIGNALS
+ /* No need to handle systems without POSIX signals;
+ all job-control systems have them. */
+ sigset_t signo_mask;
+ sigset_t old_mask;
+ Tsignal_handler handler;
+
+ /* Give the terminal back to the invoking process. */
+ OS_save_internal_state ();
+ OS_restore_external_state ();
+
+ /* Temporarily unbind this handler. */
+ handler = (current_handler (signo));
+ INSTALL_HANDLER (signo, SIG_DFL);
+
+ /* Perform the default action for this signal. */
+ UX_sigemptyset (&signo_mask);
+ UX_sigaddset ((&signo_mask), signo);
+ UX_sigprocmask (SIG_UNBLOCK, (&signo_mask), (&old_mask));
+ UX_kill ((UX_getpid ()), signo);
+ UX_sigprocmask (SIG_SETMASK, (&old_mask), 0);
+
+ /* Rebind this handler. */
+ INSTALL_HANDLER (signo, handler);
+
+ /* Get the terminal back to its original state. */
+ OS_save_external_state ();
+ OS_restore_internal_state ();
+#endif /* HAVE_POSIX_SIGNALS */
}
+void EXFUN ((*stop_signal_hook), (int signo));
+
DEFUN_STD_HANDLER (sighnd_stop,
- (restartable_exit (signo)))
+ {
+ #ifdef HAVE_POSIX_SIGNALS
+ sigset_t old_mask;
+ sigset_t jc_mask;
+
+ if (! (UX_SC_JOB_CONTROL ()))
+ return;
+ /* Initialize the signal masks. */
+ UX_sigemptyset (&jc_mask);
+ UX_sigaddset ((&jc_mask), SIGTTOU);
+ UX_sigaddset ((&jc_mask), SIGTTIN);
+ UX_sigaddset ((&jc_mask), SIGTSTP);
+ UX_sigaddset ((&jc_mask), SIGSTOP);
+ UX_sigaddset ((&jc_mask), SIGCHLD);
+
+ /* Block the job-control signals. */
+ UX_sigprocmask (SIG_BLOCK, (&jc_mask), (&old_mask));
+
+ if (stop_signal_hook == 0)
+ stop_signal_default (signo);
+ else
+ (*stop_signal_hook) (signo);
+
+ /* Restore the signal mask to its original state. */
+ UX_sigprocmask (SIG_SETMASK, (&old_mask), 0);
+ #endif /* HAVE_POSIX_SIGNALS */
+ })
void
DEFUN_VOID (OS_restartable_exit)
{
- restartable_exit (SIGTSTP);
+ stop_signal_default (SIGTSTP);
}
#ifdef HAVE_ITIMER
void
DEFUN_VOID (UX_initialize_signals)
{
+ stop_signal_hook = 0;
subprocess_death_hook = 0;
initialize_signal_descriptors ();
bind_handler (SIGINT, sighnd_control_g);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.62 1991/02/16 07:55:09 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.63 1991/03/01 00:56:27 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 62
+#define SUBVERSION 63
#endif
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.60 1990/11/27 19:13:48 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.61 1991/03/01 00:54:42 cph Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
extern PTR EXFUN (obstack_chunk_alloc, (unsigned int size));
extern void EXFUN (free, (PTR ptr));
#define obstack_chunk_free free
+extern void EXFUN (back_out_of_primitive_internal, (void));
\f
/* In order to make the interpreter tail recursive (i.e.
* to avoid calling procedures and thus saving unnecessary
#define BACK_OUT_AFTER_PRIMITIVE() \
{ \
Export_Registers(); \
- Back_Out_Of_Primitive(); \
+ back_out_of_primitive_internal (); \
Import_Registers(); \
}
\f
DEFUN (abort_to_interpreter, (argument), int argument)
{
interpreter_throw_argument = argument;
- dstack_set_position (interpreter_catch_dstack_position);
+ {
+ long old_mask = IntEnb;
+ IntEnb = 0;
+ dstack_set_position (interpreter_catch_dstack_position);
+ IntEnb = old_mask;
+ }
obstack_free ((&scratch_obstack), 0);
obstack_init (&scratch_obstack);
longjmp (interpreter_catch_env, argument);
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.54 1991/01/24 11:25:15 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.55 1991/03/01 00:55:40 cph Exp $
;;;
;;; Copyright (c) 1987-91 Massachusetts Institute of Technology
;;;
(vector-set! (get-fixed-objects-vector)
#x09 ;(fixed-objects-vector-slot 'SYSTEM-CALL-NAMES)
- #(ACCEPT ;00
- BIND ;01
- CHDIR ;02
- CHMOD ;03
- CLOSE ;04
- CONNECT ;05
- FCNTL-GETFL ;06
- FCNTL-SETFL ;07
- FSTAT ;08
- FTRUNCATE ;09
- GETCWD ;0A
- GETTIMEOFDAY ;0B
- IOCTL-TIOCGPGRP ;0C
- IOCTL-TIOCSIGSEND ;0D
- KILL ;0E
- LINK ;0F
- LISTEN ;10
- LOCALTIME ;11
- LSEEK ;12
- MALLOC ;13
- MKDIR ;14
- OPEN ;15
- OPENDIR ;16
- PIPE ;17
- READ ;18
- READLINK ;19
- REALLOC ;1A
- RENAME ;1B
- SETITIMER ;1C
- SOCKET ;1D
- SYMLINK ;1E
- TCDRAIN ;1F
- TCFLUSH ;20
- TERMINAL-GET-STATE ;21
- TERMINAL-SET-STATE ;22
- TIME ;23
- TIMES ;24
- UNLINK ;25
- VFORK ;26
- WRITE ;27
+ #(ACCEPT
+ BIND
+ CHDIR
+ CHMOD
+ CLOSE
+ CONNECT
+ FCNTL-GETFL
+ FCNTL-SETFL
+ FORK
+ FSTAT
+ FTRUNCATE
+ GETCWD
+ GETTIMEOFDAY
+ IOCTL-TIOCGPGRP
+ IOCTL-TIOCSIGSEND
+ KILL
+ LINK
+ LISTEN
+ LOCALTIME
+ LSEEK
+ MALLOC
+ MKDIR
+ OPEN
+ OPENDIR
+ PAUSE
+ PIPE
+ READ
+ READLINK
+ REALLOC
+ RENAME
+ SETITIMER
+ SETPGID
+ SIGHOLD
+ SIGPROCMASK
+ SIGSUSPEND
+ SLEEP
+ SOCKET
+ SYMLINK
+ TCDRAIN
+ TCFLUSH
+ TCGETPGRP
+ TCSETPGRP
+ TERMINAL-GET-STATE
+ TERMINAL-SET-STATE
+ TIME
+ TIMES
+ UNLINK
+ VFORK
+ WRITE
))
\f
;;; [] System-call errors
;;; This identification string is saved by the system.
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.54 1991/01/24 11:25:15 cph Exp $"
\ No newline at end of file
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.55 1991/03/01 00:55:40 cph Exp $"
\ No newline at end of file
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.62 1991/02/16 07:55:09 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.63 1991/03/01 00:56:27 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 62
+#define SUBVERSION 63
#endif
projects / mit-scheme.git / commitdiff