From a3962b9a27939a8dd1dfea4e02e506c6703ee765 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 1 Mar 1991 00:56:27 +0000 Subject: [PATCH] * New primitive `make-pipe'. * Redesign of subprocess primitives. New primitives are lower-level, permitting more flexibility, and support job control properly. --- v7/src/microcode/extern.h | 10 +- v7/src/microcode/hooks.c | 34 +- v7/src/microcode/interp.c | 14 +- v7/src/microcode/osio.h | 4 +- v7/src/microcode/osproc.h | 57 +++- v7/src/microcode/osscheme.c | 22 +- v7/src/microcode/osscheme.h | 11 +- v7/src/microcode/prims.h | 10 +- v7/src/microcode/prosfile.c | 13 +- v7/src/microcode/prosio.c | 32 +- v7/src/microcode/prosproc.c | 300 +++++++++++------ v7/src/microcode/utabmd.scm | 93 ++--- v7/src/microcode/utils.c | 66 ++-- v7/src/microcode/ux.c | 140 +++++++- v7/src/microcode/ux.h | 100 +++++- v7/src/microcode/uxctty.c | 10 +- v7/src/microcode/uxio.c | 16 +- v7/src/microcode/uxproc.c | 652 ++++++++++++++++++++++++------------ v7/src/microcode/uxproc.h | 19 +- v7/src/microcode/uxsig.c | 193 ++++------- v7/src/microcode/version.h | 4 +- v8/src/microcode/interp.c | 14 +- v8/src/microcode/utabmd.scm | 93 ++--- v8/src/microcode/version.h | 4 +- 24 files changed, 1231 insertions(+), 680 deletions(-) diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h index 0cc313e06..5aa4dbfa4 100644 --- a/v7/src/microcode/extern.h +++ b/v7/src/microcode/extern.h @@ -1,8 +1,8 @@ /* -*-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 @@ -234,11 +234,13 @@ extern void EXFUN (termination_gc_out_of_space, (void)); 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 (); diff --git a/v7/src/microcode/hooks.c b/v7/src/microcode/hooks.c index ee87b0a72..83f0c971f 100644 --- a/v7/src/microcode/hooks.c +++ b/v7/src/microcode/hooks.c @@ -1,8 +1,8 @@ /* -*-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 @@ -138,12 +138,10 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2, 0) } \ /* 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; \ @@ -282,8 +280,7 @@ DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_error_procedure, 3, 3, 0) /* 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! */ @@ -552,13 +549,10 @@ DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_with_interrupt_mask, 2, 2, 0) { 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 (); @@ -574,13 +568,11 @@ DEFINE_PRIMITIVE ("WITH-INTERRUPTS-REDUCED", Prim_with_interrupts_reduced, 2, 2, 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); diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c index 557b64e06..25e1c8676 100644 --- a/v7/src/microcode/interp.c +++ b/v7/src/microcode/interp.c @@ -1,8 +1,8 @@ /* -*-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 @@ -48,6 +48,7 @@ MIT in each case. */ 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)); /* In order to make the interpreter tail recursive (i.e. * to avoid calling procedures and thus saving unnecessary @@ -158,7 +159,7 @@ if (GC_Check(Amount)) \ #define BACK_OUT_AFTER_PRIMITIVE() \ { \ Export_Registers(); \ - Back_Out_Of_Primitive(); \ + back_out_of_primitive_internal (); \ Import_Registers(); \ } @@ -399,7 +400,12 @@ void 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); diff --git a/v7/src/microcode/osio.h b/v7/src/microcode/osio.h index b9d937618..4e0450956 100644 --- a/v7/src/microcode/osio.h +++ b/v7/src/microcode/osio.h @@ -1,6 +1,6 @@ /* -*-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 @@ -71,6 +71,8 @@ extern long EXFUN (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)); diff --git a/v7/src/microcode/osproc.h b/v7/src/microcode/osproc.h index 525041f51..c250f77e5 100644 --- a/v7/src/microcode/osproc.h +++ b/v7/src/microcode/osproc.h @@ -1,8 +1,8 @@ /* -*-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 @@ -49,35 +49,68 @@ enum process_status 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 */ diff --git a/v7/src/microcode/osscheme.c b/v7/src/microcode/osscheme.c index 4e1fe75f6..8439bff6a 100644 --- a/v7/src/microcode/osscheme.c +++ b/v7/src/microcode/osscheme.c @@ -1,8 +1,8 @@ /* -*-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 @@ -83,6 +83,12 @@ DEFUN_VOID (request_suspend_interrupt) REQUEST_INTERRUPT (INT_Suspend); } +int +DEFUN_VOID (pending_interrupts_p) +{ + return (INTERRUPT_PENDING_P (INT_Mask)); +} + void DEFUN_VOID (deliver_pending_interrupts) { @@ -90,6 +96,18 @@ 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) { diff --git a/v7/src/microcode/osscheme.h b/v7/src/microcode/osscheme.h index bb92f6758..0eb84e3ce 100644 --- a/v7/src/microcode/osscheme.h +++ b/v7/src/microcode/osscheme.h @@ -1,8 +1,8 @@ /* -*-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 @@ -38,7 +38,6 @@ MIT in each case. */ #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; @@ -64,5 +63,11 @@ extern void EXFUN (request_character_interrupt, (void)); 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 */ diff --git a/v7/src/microcode/prims.h b/v7/src/microcode/prims.h index 877122827..2d397a015 100644 --- a/v7/src/microcode/prims.h +++ b/v7/src/microcode/prims.h @@ -1,8 +1,8 @@ /* -*-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 @@ -35,6 +35,8 @@ MIT in each case. */ /* This file contains some macros for defining primitives, for argument type or value checking, and for accessing the arguments. */ + +#include "ansidecl.h" /* Definition of primitives. */ @@ -83,8 +85,8 @@ extern void canonicalize_primitive_context (); #define ARG_REF(argument) (STACK_REF (argument - 1)) #define LEXPR_N_ARGUMENTS() (Regs [REGBLOCK_LEXPR_ACTUALS]) -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 (); diff --git a/v7/src/microcode/prosfile.c b/v7/src/microcode/prosfile.c index 0f58e0a33..10570abc1 100644 --- a/v7/src/microcode/prosfile.c +++ b/v7/src/microcode/prosfile.c @@ -1,8 +1,8 @@ /* -*-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 @@ -95,14 +95,7 @@ Second argument MODE says how to open the file:\n\ } } -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); diff --git a/v7/src/microcode/prosio.c b/v7/src/microcode/prosio.c index 9c3827e5c..f44ea4be8 100644 --- a/v7/src/microcode/prosio.c +++ b/v7/src/microcode/prosio.c @@ -1,6 +1,6 @@ /* -*-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 @@ -67,21 +67,6 @@ DEFUN (arg_channel, (arg_number), int arg_number) 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.") { @@ -206,3 +191,18 @@ DEFINE_PRIMITIVE ("CHANNEL-BLOCKING", Prim_channel_blocking, 1, 1, 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); + } +} diff --git a/v7/src/microcode/prosproc.c b/v7/src/microcode/prosproc.c index 7bc0e98e3..a0e59270b 100644 --- a/v7/src/microcode/prosproc.c +++ b/v7/src/microcode/prosproc.c @@ -1,8 +1,8 @@ /* -*-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 @@ -40,7 +40,7 @@ MIT in each case. */ static int EXFUN (string_vector_p, (SCHEME_OBJECT vector)); static char ** EXFUN (convert_string_vector, (SCHEME_OBJECT vector)); - + static Tprocess DEFUN (arg_process, (argument_number), int argument_number) { @@ -59,16 +59,47 @@ 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)); \ + } \ +} -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); @@ -80,20 +111,50 @@ Fourth arg CTTY-TYPE specifies the program's controlling terminal type:\n\ 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)); + } } } - + static int DEFUN (string_vector_p, (vector), SCHEME_OBJECT vector) { @@ -123,7 +184,7 @@ DEFUN (convert_string_vector, (vector), SCHEME_OBJECT vector) (*scan_result) = 0; return (result); } - + DEFINE_PRIMITIVE ("SCHEME-ENVIRONMENT", Prim_scheme_environment, 0, 0, 0) { PRIMITIVE_HEADER (0); @@ -145,28 +206,19 @@ DEFINE_PRIMITIVE ("SCHEME-ENVIRONMENT", Prim_scheme_environment, 0, 0, 0) } } } - + 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); } @@ -178,8 +230,14 @@ DEFINE_PRIMITIVE ("PROCESS-TABLE", Prim_process_table, 0, 0, { 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 = @@ -208,72 +266,35 @@ DEFINE_PRIMITIVE ("PROCESS-ID", Prim_process_id, 1, 1, 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); - } -} - -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\ @@ -291,6 +312,30 @@ This is a nonnegative integer, which depends on the process's status:\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); + } +} + DEFINE_PRIMITIVE ("PROCESS-SIGNAL", Prim_process_signal, 2, 2, "Send a signal to process PROCESS-NUMBER; second arg SIGNAL says which one.") { @@ -307,21 +352,76 @@ DEFINE_PRIMITIVE ("PROCESS-SIGNAL", Prim_process_signal, 2, 2, } 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) + +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))); + } +} diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm index e69afefea..5c0f69011 100644 --- a/v7/src/microcode/utabmd.scm +++ b/v7/src/microcode/utabmd.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -575,46 +575,55 @@ (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 )) ;;; [] System-call errors @@ -680,4 +689,4 @@ ;;; 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 diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c index e863ac022..1162cc4a1 100644 --- a/v7/src/microcode/utils.c +++ b/v7/src/microcode/utils.c @@ -1,6 +1,6 @@ /* -*-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 @@ -45,8 +45,7 @@ MIT in each case. */ 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; @@ -93,17 +92,10 @@ Setup_Interrupt (Masked_Interrupts) Global_Interrupt_Hook (); Handler = (VECTOR_REF (Int_Vector, Int_Number)); -/* Setup_Interrupt continues on the next page */ - -/* 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. @@ -122,7 +114,6 @@ Passed_Checks: /* This label may be used in Global_Interrupt_Hook */ Pushed(); /* Turn off interrupts */ SET_INTERRUPT_MASK(New_Int_Enb); - return; } /* Error processing utilities */ @@ -168,12 +159,22 @@ Stack_Death () /*NOTREACHED*/ } -/* 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; @@ -185,7 +186,7 @@ Back_Out_Of_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)); @@ -198,7 +199,13 @@ Back_Out_Of_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 (); } /* canonicalize_primitive_context should be used by "unsafe" primitives @@ -242,15 +249,14 @@ canonicalize_primitive_context () 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*/ @@ -523,11 +529,8 @@ Do_Micro_Error (Err, From_Pop_Return) 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); @@ -536,18 +539,17 @@ Do_Micro_Error (Err, From_Pop_Return) { 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 */ @@ -981,10 +983,8 @@ Translate_To_Point (Target) } #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))); diff --git a/v7/src/microcode/ux.c b/v7/src/microcode/ux.c index 83c34fa8c..c1cfab49c 100644 --- a/v7/src/microcode/ux.c +++ b/v7/src/microcode/ux.c @@ -1,6 +1,6 @@ /* -*-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 @@ -42,7 +42,6 @@ DEFUN (UX_prim_check_errno, (name), enum syscall_names name) deliver_pending_interrupts (); } - #ifdef HAVE_TERMIOS int @@ -206,8 +205,7 @@ pid_t 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 @@ -415,3 +413,137 @@ DEFUN_VOID (UX_SC_CLK_TCK) } #endif /* _POSIX */ + +#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); + } +} + +#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 */ diff --git a/v7/src/microcode/ux.h b/v7/src/microcode/ux.h index f4559ae3e..961d88938 100644 --- a/v7/src/microcode/ux.h +++ b/v7/src/microcode/ux.h @@ -1,6 +1,6 @@ /* -*-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 @@ -70,6 +70,7 @@ enum syscall_names syscall_connect, syscall_fcntl_GETFL, syscall_fcntl_SETFL, + syscall_fork, syscall_fstat, syscall_ftruncate, syscall_getcwd, @@ -85,16 +86,24 @@ enum syscall_names 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, @@ -472,6 +481,58 @@ typedef int wait_status_t; #endif /* UNION_WAIT_STATUS */ +/* 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 + /* constants for access() */ #ifndef R_OK #define R_OK 4 @@ -545,6 +606,7 @@ extern char * EXFUN (getlogin, (void)); #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 @@ -561,10 +623,12 @@ extern char * EXFUN (getlogin, (void)); #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 @@ -821,16 +885,34 @@ extern int EXFUN (UX_kill, (pid_t pid, int sig)); #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 diff --git a/v7/src/microcode/uxctty.c b/v7/src/microcode/uxctty.c index 2ff5b4cf1..a586df50d 100644 --- a/v7/src/microcode/uxctty.c +++ b/v7/src/microcode/uxctty.c @@ -1,8 +1,8 @@ /* -*-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 @@ -243,6 +243,12 @@ DEFUN_VOID (OS_ctty_disabled_char) { return ((ctty_fildes >= 0) ? (UX_PC_VDISABLE (ctty_fildes)) : '\377'); } + +int +DEFUN_VOID (OS_ctty_fd) +{ + return (ctty_fildes); +} #if 0 /* not currently used */ diff --git a/v7/src/microcode/uxio.c b/v7/src/microcode/uxio.c index 520a6c921..50ef39c83 100644 --- a/v7/src/microcode/uxio.c +++ b/v7/src/microcode/uxio.c @@ -1,6 +1,6 @@ /* -*-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 @@ -221,6 +221,20 @@ DEFUN (OS_channel_write_string, (channel, string), 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 (); +} #ifdef FCNTL_NONBLOCK diff --git a/v7/src/microcode/uxproc.c b/v7/src/microcode/uxproc.c index 859394418..105d3148e 100644 --- a/v7/src/microcode/uxproc.c +++ b/v7/src/microcode/uxproc.c @@ -1,8 +1,8 @@ /* -*-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 @@ -37,16 +37,102 @@ MIT in each case. */ #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)); - +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; + +/* 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 */ + void DEFUN_VOID (UX_initialize_processes) { @@ -62,13 +148,18 @@ 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 @@ -79,6 +170,20 @@ DEFUN_VOID (UX_reset_processes) 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) { @@ -86,8 +191,9 @@ 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); } @@ -95,221 +201,202 @@ DEFUN_VOID (process_allocate) 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; } 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); - } -} - -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); +} + #define DEFUN_PROCESS_ACCESSOR(name, result_type, accessor) \ result_type \ DEFUN (name, (process), Tprocess process) \ @@ -319,33 +406,19 @@ 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); -} - 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 @@ -360,12 +433,6 @@ DEFUN (OS_process_stop, (process), Tprocess process) 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) { @@ -377,9 +444,158 @@ DEFUN (OS_process_quit, (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); + } +} -#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); +} + +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); +} + /* Set up the terminal at the other end of a pseudo-terminal that we will be controlling an inferior through. */ @@ -400,9 +616,8 @@ DEFUN (OS_process_quit, (process), Tprocess process) #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) @@ -422,13 +637,12 @@ DEFUN (child_setup_tty, (channel), Tchannel channel) } #else /* not HAVE_TERMIOS */ - + #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) @@ -464,9 +678,8 @@ DEFUN (child_setup_tty, (channel), Tchannel channel) #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); @@ -478,4 +691,3 @@ DEFUN (child_setup_tty, (channel), Tchannel channel) #endif /* HAVE_BSD_TTY_DRIVER */ #endif /* HAVE_TERMIO */ #endif /* HAVE_TERMIOS */ -#endif /* HAVE_PTYS */ diff --git a/v7/src/microcode/uxproc.h b/v7/src/microcode/uxproc.h index 53faf7b50..4c274c6b8 100644 --- a/v7/src/microcode/uxproc.h +++ b/v7/src/microcode/uxproc.h @@ -1,8 +1,8 @@ /* -*-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 @@ -39,25 +39,16 @@ MIT in each case. */ 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; diff --git a/v7/src/microcode/uxsig.c b/v7/src/microcode/uxsig.c index 1b170b44b..055e76cd7 100644 --- a/v7/src/microcode/uxsig.c +++ b/v7/src/microcode/uxsig.c @@ -1,8 +1,8 @@ /* -*-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 @@ -65,54 +65,7 @@ DEFUN (INSTALL_HANDLER, (signo, handler), 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) - -#else /* not HAVE_BSD_SIGNALS */ #ifdef HAVE_SYSV3_SIGNALS static Tsignal_handler @@ -125,9 +78,6 @@ DEFUN (current_handler, (signo), int signo) } #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) @@ -146,9 +96,6 @@ DEFUN (current_handler, (signo), int 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) @@ -156,7 +103,6 @@ DEFUN (current_handler, (signo), int signo) #define EXIT_HANDLER UX_signal #endif /* HAVE_SYSV3_SIGNALS */ -#endif /* HAVE_BSD_SIGNALS */ #endif /* HAVE_POSIX_SIGNALS */ /* Signal Descriptors */ @@ -258,62 +204,11 @@ DEFUN (find_signal_name, (signo), int signo) #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 - + static void DEFUN_VOID (initialize_signal_descriptors) { @@ -467,34 +362,75 @@ static void EXFUN 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 @@ -610,6 +546,7 @@ DEFUN (bind_handler, (signo, handler), void DEFUN_VOID (UX_initialize_signals) { + stop_signal_hook = 0; subprocess_death_hook = 0; initialize_signal_descriptors (); bind_handler (SIGINT, sighnd_control_g); diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 3d7ef117a..6664604be 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-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 @@ -46,5 +46,5 @@ MIT in each case. */ #define VERSION 11 #endif #ifndef SUBVERSION -#define SUBVERSION 62 +#define SUBVERSION 63 #endif diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c index d3766bf78..4eadb2c91 100644 --- a/v8/src/microcode/interp.c +++ b/v8/src/microcode/interp.c @@ -1,8 +1,8 @@ /* -*-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 @@ -48,6 +48,7 @@ MIT in each case. */ 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)); /* In order to make the interpreter tail recursive (i.e. * to avoid calling procedures and thus saving unnecessary @@ -158,7 +159,7 @@ if (GC_Check(Amount)) \ #define BACK_OUT_AFTER_PRIMITIVE() \ { \ Export_Registers(); \ - Back_Out_Of_Primitive(); \ + back_out_of_primitive_internal (); \ Import_Registers(); \ } @@ -399,7 +400,12 @@ void 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); diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm index ba3e0cd33..ddf3a9a90 100644 --- a/v8/src/microcode/utabmd.scm +++ b/v8/src/microcode/utabmd.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -575,46 +575,55 @@ (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 )) ;;; [] System-call errors @@ -680,4 +689,4 @@ ;;; 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 diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index c049ce8b4..1ff20fe11 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-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 @@ -46,5 +46,5 @@ MIT in each case. */ #define VERSION 11 #endif #ifndef SUBVERSION -#define SUBVERSION 62 +#define SUBVERSION 63 #endif -- 2.25.1