From: Matt Birkholz Date: Thu, 12 Sep 2013 19:45:59 +0000 (-0700) Subject: gtk: Minimize differences with origin/master. X-Git-Tag: mit-scheme-pucked-9.2.12~474 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ba8b54c5f09354884449b8ae903e97f57b88dabf;p=mit-scheme.git gtk: Minimize differences with origin/master. This mainly undeletes the primitives TTY-GET-INTERRUPT-CHARS and TTY-SET-INTERRUPT-CHARS!. They will not work correctly after gtkio's signal forwarder is installed, but that does not seem to be a problem. Deleting them was not a problem! They are only undeleted now to minimize differences between the Gtk branch and origin/master. --- diff --git a/src/Setup.sh b/src/Setup.sh index ea7b4227d..b9ca82cdf 100755 --- a/src/Setup.sh +++ b/src/Setup.sh @@ -85,7 +85,6 @@ maybe_link lib/include ../microcode maybe_link lib/optiondb.scm ../etc/optiondb.scm maybe_link lib/runtime ../runtime maybe_link lib/compiler ../compiler -maybe_link lib/sos ../sos maybe_link lib/mit-scheme.h ../microcode/pruxffi.h maybe_link lib/ffi ../ffi diff --git a/src/gtk/gtkio.c b/src/gtk/gtkio.c index 8534508ee..8ce801cdb 100644 --- a/src/gtk/gtkio.c +++ b/src/gtk/gtkio.c @@ -32,16 +32,17 @@ USA. /* Presumed externs/const of the Gtk-ready machine. */ extern double OS_real_time_clock (void); extern int OS_process_any_status_change (void); -extern int interrupts_p (void); extern int OS_select_registry_length (unsigned long registry); +#define SELECT_MODE_READ 1 +#define SELECT_MODE_WRITE 2 extern void OS_select_registry_entry (unsigned long registry, int i, int *fd, unsigned int *mode); +extern void OS_syserr_names (unsigned long *, const char ***); extern void Interpret (int pop_return_p); -#define SELECT_MODE_READ 1 -#define SELECT_MODE_WRITE 2 extern void alienate_float_environment (void); extern void foreach_async_signal (void(*func)(int signo)); -extern void OS_syserr_names (unsigned long *, const char ***); +extern void abort_to_c (void); +extern int interrupts_p (void); static void init_signal_handling (void); diff --git a/src/microcode/ntsig.c b/src/microcode/ntsig.c index 30303d5fc..d32585d30 100644 --- a/src/microcode/ntsig.c +++ b/src/microcode/ntsig.c @@ -190,6 +190,46 @@ update_interrupt_characters (void) } return; } + +unsigned int +OS_ctty_num_int_chars (void) +{ + return (NUM_INT_CHANNELS); +} + +cc_t * +OS_ctty_get_int_chars (void) +{ + return (&int_chars[0]); +} + +void +OS_ctty_set_int_chars (cc_t * new_int_chars) +{ + int i; + + for (i = 0; i < NUM_INT_CHANNELS; i++) + int_chars[i] = new_int_chars[i]; + update_interrupt_characters (); + return; +} + +cc_t * +OS_ctty_get_int_char_handlers (void) +{ + return (&int_handlers[0]); +} + +void +OS_ctty_set_int_char_handlers (cc_t * new_int_handlers) +{ + int i; + + for (i = 0; i < NUM_INT_CHANNELS; i++) + int_handlers[i] = new_int_handlers[i]; + update_interrupt_characters (); + return; +} static void console_write_string (unsigned char * string) diff --git a/src/microcode/os2ctty.c b/src/microcode/os2ctty.c index fb84587d3..e62edd2c2 100644 --- a/src/microcode/os2ctty.c +++ b/src/microcode/os2ctty.c @@ -94,11 +94,59 @@ OS_ctty_set_interrupt_enables (Tinterrupt_enables * mask) keyboard_interrupt_enables = ((*mask) & ALL_ENABLES); } +unsigned int +OS_ctty_num_int_chars (void) +{ + return (KB_INT_CHARS_SIZE + 1); +} + cc_t OS_tty_map_interrupt_char (cc_t int_char) { return (int_char); } + +cc_t * +OS_ctty_get_int_chars (void) +{ + static cc_t characters [KB_INT_CHARS_SIZE + 1]; + unsigned int i; + for (i = 0; (i < KB_INT_CHARS_SIZE); i += 1) + (characters[i]) = (keyboard_interrupt_characters[i]); + (characters[i]) = '\0'; /* dummy for control-break */ + return (characters); +} + +void +OS_ctty_set_int_chars (cc_t * characters) +{ + unsigned int i; + for (i = 0; (i < KB_INT_CHARS_SIZE); i += 1) + (keyboard_interrupt_characters[i]) = (characters[i]); + update_keyboard_interrupt_characters (); +} + +cc_t * +OS_ctty_get_int_char_handlers (void) +{ + static cc_t handlers [KB_INT_CHARS_SIZE + 1]; + unsigned int i; + for (i = 0; (i < KB_INT_CHARS_SIZE); i += 1) + (handlers[i]) = ((cc_t) (keyboard_interrupt_handlers[i])); + (handlers[i]) = ((cc_t) keyboard_break_interrupt); + return (handlers); +} + +void +OS_ctty_set_int_char_handlers (cc_t * handlers) +{ + unsigned int i; + for (i = 0; (i < KB_INT_CHARS_SIZE); i += 1) + (keyboard_interrupt_handlers[i]) = + ((enum interrupt_handler) (handlers[i])); + keyboard_break_interrupt = ((enum interrupt_handler) (handlers[i])); + update_keyboard_interrupt_characters (); +} static char check_if_enabled (enum interrupt_handler handler) diff --git a/src/microcode/osctty.h b/src/microcode/osctty.h index 27889bb68..bb58a3ffb 100644 --- a/src/microcode/osctty.h +++ b/src/microcode/osctty.h @@ -37,4 +37,10 @@ typedef unsigned int Tinterrupt_enables; extern void OS_ctty_get_interrupt_enables (Tinterrupt_enables * mask); extern void OS_ctty_set_interrupt_enables (Tinterrupt_enables * mask); +extern unsigned int OS_ctty_num_int_chars (void); +extern cc_t * OS_ctty_get_int_chars (void); +extern cc_t * OS_ctty_get_int_char_handlers (void); +extern void OS_ctty_set_int_chars (cc_t *); +extern void OS_ctty_set_int_char_handlers (cc_t *); + #endif /* SCM_OSCTTY_H */ diff --git a/src/microcode/osio.h b/src/microcode/osio.h index 7637f4387..c9599bd43 100644 --- a/src/microcode/osio.h +++ b/src/microcode/osio.h @@ -102,9 +102,6 @@ extern void OS_remove_from_select_registry (select_registry_t registry, int fd, unsigned int mode); extern unsigned int OS_select_registry_length (select_registry_t registry); -extern void OS_select_registry_entry - (select_registry_t registry, unsigned int index, - int * fd_r, unsigned int * mode_r); extern void OS_select_registry_result (select_registry_t registry, unsigned int index, int * fd_r, unsigned int * mode_r); @@ -113,6 +110,5 @@ extern int OS_test_select_registry extern int OS_test_select_descriptor (int fd, int blockp, unsigned int mode); extern int OS_pause (int blockp); -extern select_registry_t arg_select_registry (int arg_number); #endif /* SCM_OSIO_H */ diff --git a/src/microcode/prosio.c b/src/microcode/prosio.c index 769af21bf..e3e3ebb24 100644 --- a/src/microcode/prosio.c +++ b/src/microcode/prosio.c @@ -255,7 +255,7 @@ DEFINE_PRIMITIVE ("NEW-MAKE-PIPE", Prim_new_make_pipe, 2, 2, /* Select registry */ -select_registry_t +static select_registry_t arg_select_registry (int arg_number) { return ((select_registry_t) (arg_ulong_integer (arg_number))); diff --git a/src/microcode/prostty.c b/src/microcode/prostty.c index 59843da44..d98f092ab 100644 --- a/src/microcode/prostty.c +++ b/src/microcode/prostty.c @@ -104,3 +104,53 @@ DEFINE_PRIMITIVE ("TTY-SET-INTERRUPT-ENABLES", Prim_tty_set_interrupt_enables, 1 } PRIMITIVE_RETURN (UNSPECIFIC); } + +DEFINE_PRIMITIVE ("TTY-GET-INTERRUPT-CHARS", Prim_tty_get_interrupt_chars, 0, 0, + "Return the current interrupt characters as a string.") +{ + PRIMITIVE_HEADER (0); + { + unsigned int i; + unsigned int num_chars = (OS_ctty_num_int_chars ()); + SCHEME_OBJECT result = (allocate_string (num_chars * 2)); + cc_t * int_chars = (OS_ctty_get_int_chars ()); + cc_t * int_handlers = (OS_ctty_get_int_char_handlers ()); + char * scan = (STRING_POINTER (result)); + + for (i = 0; i < num_chars; i++) + { + (*scan++) = (int_chars[i]); + (*scan++) = (int_handlers[i]); + } + PRIMITIVE_RETURN (result); + } +} + +DEFINE_PRIMITIVE ("TTY-SET-INTERRUPT-CHARS!", Prim_tty_set_interrupt_chars, 1, 1, + "Change the current interrupt characters to STRING.\n\ +STRING must be in the correct form for this operating system.") +{ + PRIMITIVE_HEADER (1); + { + unsigned int i; + unsigned int num_chars = (OS_ctty_num_int_chars ()); + cc_t * int_chars = (OS_ctty_get_int_chars ()); + cc_t * int_handlers = (OS_ctty_get_int_char_handlers ()); + SCHEME_OBJECT argument = (ARG_REF (1)); + char * scan; + + if (! ((STRING_P (argument)) + && (((unsigned int) (STRING_LENGTH (argument))) + == (num_chars * 2)))) + error_wrong_type_arg (1); + + for (i = 0, scan = (STRING_POINTER (argument)); i < num_chars; i++) + { + (int_chars[i]) = (*scan++); + (int_handlers[i]) = (*scan++); + } + OS_ctty_set_int_chars (int_chars); + OS_ctty_set_int_char_handlers (int_handlers); + } + PRIMITIVE_RETURN (UNSPECIFIC); +} diff --git a/src/microcode/pruxffi.h b/src/microcode/pruxffi.h index 57b827871..017d64ac5 100644 --- a/src/microcode/pruxffi.h +++ b/src/microcode/pruxffi.h @@ -57,7 +57,6 @@ extern void callout_unseal (CalloutTrampIn expected); extern void callout_continue (CalloutTrampIn tramp); extern char* callout_lunseal (CalloutTrampIn expected); extern void callout_pop (char* tos); -extern void abort_to_c (void); typedef void (*CallbackKernel)(void); extern void callback_run_kernel (long callback_id, CallbackKernel kernel); diff --git a/src/microcode/uxctty.c b/src/microcode/uxctty.c index d707e39ea..983ae4cfb 100644 --- a/src/microcode/uxctty.c +++ b/src/microcode/uxctty.c @@ -306,6 +306,75 @@ OS_ctty_fd (void) return (ctty_fildes); } +#if 0 + +/* not currently used */ +static void +ctty_get_interrupt_chars (Tinterrupt_chars * ic) +{ + Ttty_state s; + if ((get_terminal_state (ctty_fildes, (&s))) == 0) + { +#ifdef HAVE_TERMIOS_H + (ic -> quit) = ((s . tio . c_cc) [VQUIT]); + (ic -> intrpt) = ((s . tio . c_cc) [VINTR]); + (ic -> tstp) = ((s . tio . c_cc) [VSUSP]); + +#ifdef VDSUSP + (ic -> dtstp) = ((s . tio . c_cc) [VDSUSP]); +#else /* not VDSUSP */ +#ifdef __HPUX__ + (ic -> dtstp) = (s . ltc . t_dsuspc); +#endif /* __HPUX__ */ +#endif /* not VDSUSP */ + +#else /* not HAVE_TERMIOS_H */ +#ifdef HAVE_TERMIO_H + + (ic -> quit) = ((s . tio . c_cc) [VQUIT]); + (ic -> intrpt) = ((s . tio . c_cc) [VINTR]); +#ifdef HAVE_STRUCT_LTCHARS + (ic -> tstp) = (s . ltc . t_suspc); + (ic -> dtstp) = (s . ltc . t_dsuspc); +#else /* not HAVE_STRUCT_LTCHARS */ + { + cc_t disabled_char = (UX_PC_VDISABLE (ctty_fildes)); + (ic -> tstp) = disabled_char; + (ic -> dtstp) = disabled_char; + } +#endif /* not HAVE_STRUCT_LTCHARS */ + +#else /* not HAVE_TERMIO_H */ +#ifdef HAVE_SGTTY_H + + (ic -> quit) = (s . tc . t_quitc); + (ic -> intrpt) = (s . tc . t_intrc); +#ifdef HAVE_STRUCT_LTCHARS + (ic -> tstp) = (s . ltc . t_suspc); + (ic -> dtstp) = (s . ltc . t_dsuspc); +#else /* not HAVE_STRUCT_LTCHARS */ + { + cc_t disabled_char = (UX_PC_VDISABLE (ctty_fildes)); + (ic -> tstp) = disabled_char; + (ic -> dtstp) = disabled_char; + } +#endif /* not HAVE_STRUCT_LTCHARS */ + +#endif /* HAVE_SGTTY_H */ +#endif /* HAVE_TERMIO_H */ +#endif /* HAVE_TERMIOS_H */ + } + else + { + cc_t disabled_char = (UX_PC_VDISABLE (ctty_fildes)); + (ic -> quit) = disabled_char; + (ic -> intrpt) = disabled_char; + (ic -> tstp) = disabled_char; + (ic -> dtstp) = disabled_char; + } +} +#endif /* 0 */ + static void ctty_set_interrupt_chars (Tinterrupt_chars * ic) { @@ -385,7 +454,77 @@ OS_ctty_set_interrupt_enables (Tinterrupt_enables * mask) current_interrupt_enables = (*mask); ctty_update_interrupt_chars (); } + +#if 0 + +void +OS_ctty_set_interrupt_chars (cc_t quit_char, + cc_t int_char, + cc_t tstp_char) +{ + (current_interrupt_chars . quit) = quit_char; + (current_interrupt_chars . intrpt) = int_char; + (current_interrupt_chars . tstp) = tstp_char; + ctty_update_interrupt_chars (); +} +#endif + +unsigned int +OS_ctty_num_int_chars (void) +{ + return (3); +} + +cc_t * +OS_ctty_get_int_chars (void) +{ + static cc_t int_chars [3]; + + int_chars[0] = current_interrupt_chars.quit; + int_chars[1] = current_interrupt_chars.intrpt; + int_chars[2] = current_interrupt_chars.tstp; + return (& int_chars [0]); +} + +void +OS_ctty_set_int_chars (cc_t * int_chars) +{ + current_interrupt_chars.quit = int_chars[0]; + current_interrupt_chars.intrpt = int_chars[1]; + current_interrupt_chars.tstp = int_chars[2]; + ctty_update_interrupt_chars (); + return; +} +extern enum interrupt_handler OS_signal_quit_handler (void); +extern enum interrupt_handler OS_signal_int_handler (void); +extern enum interrupt_handler OS_signal_tstp_handler (void); +extern void OS_signal_set_interrupt_handlers + (enum interrupt_handler quit_handler, + enum interrupt_handler int_handler, + enum interrupt_handler tstp_handler); + +cc_t * +OS_ctty_get_int_char_handlers (void) +{ + static cc_t int_handlers [3]; + + int_handlers[0] = ((cc_t) (OS_signal_quit_handler ())); + int_handlers[1] = ((cc_t) (OS_signal_int_handler ())); + int_handlers[2] = ((cc_t) (OS_signal_tstp_handler ())); + return (& int_handlers [0]); +} + +void +OS_ctty_set_int_char_handlers (cc_t * int_handlers) +{ + OS_signal_set_interrupt_handlers + (((enum interrupt_handler) (int_handlers [0])), + ((enum interrupt_handler) (int_handlers [1])), + ((enum interrupt_handler) (int_handlers [2]))); + return; +} + void UX_initialize_ctty (int interactive) { diff --git a/src/microcode/uxsig.c b/src/microcode/uxsig.c index ba7b4218c..7d8590789 100644 --- a/src/microcode/uxsig.c +++ b/src/microcode/uxsig.c @@ -879,6 +879,135 @@ interactive_interrupt_handler (SIGCONTEXT_T * scp) } } +static enum interrupt_handler +encode_interrupt_handler (Tsignal_handler handler) +{ + return + ((handler == ((Tsignal_handler) sighnd_control_g)) + ? interrupt_handler_control_g + : (handler == ((Tsignal_handler) sighnd_interactive)) + ? interrupt_handler_interactive + : (handler == ((Tsignal_handler) sighnd_stop)) + ? interrupt_handler_stop + : (handler == ((Tsignal_handler) sighnd_terminate)) + ? interrupt_handler_terminate + : (handler == ((Tsignal_handler) SIG_IGN)) + ? interrupt_handler_ignore + : (handler == ((Tsignal_handler) SIG_DFL)) + ? interrupt_handler_default + : interrupt_handler_unknown); +} + +static Tsignal_handler +decode_interrupt_handler (enum interrupt_handler encoding) +{ + return + ((encoding == interrupt_handler_control_g) + ? ((Tsignal_handler) sighnd_control_g) + : (encoding == interrupt_handler_interactive) + ? ((Tsignal_handler) sighnd_interactive) + : (encoding == interrupt_handler_stop) + ? ((Tsignal_handler) sighnd_stop) + : (encoding == interrupt_handler_terminate) + ? ((Tsignal_handler) sighnd_terminate) + : (encoding == interrupt_handler_ignore) + ? ((Tsignal_handler) SIG_IGN) + : (encoding == interrupt_handler_default) + ? ((Tsignal_handler) SIG_DFL) + : ((Tsignal_handler) 0)); +} + +enum interrupt_handler +OS_signal_quit_handler (void) +{ + return (encode_interrupt_handler (current_handler (SIGQUIT))); +} + +enum interrupt_handler +OS_signal_int_handler (void) +{ + return (encode_interrupt_handler (current_handler (SIGINT))); +} + +enum interrupt_handler +OS_signal_tstp_handler (void) +{ + return + ((UX_SC_JOB_CONTROL ()) + ? (encode_interrupt_handler (current_handler (SIGTSTP))) + : interrupt_handler_ignore); +} + +void +OS_signal_set_interrupt_handlers (enum interrupt_handler quit_handler, + enum interrupt_handler int_handler, + enum interrupt_handler tstp_handler) +{ + { + Tsignal_handler handler = (decode_interrupt_handler (quit_handler)); + if (handler != 0) + INSTALL_HANDLER (SIGQUIT, handler); + } + { + Tsignal_handler handler = (decode_interrupt_handler (int_handler)); + if (handler != 0) + INSTALL_HANDLER (SIGINT, handler); + } + if (UX_SC_JOB_CONTROL ()) + { + Tsignal_handler handler = (decode_interrupt_handler (tstp_handler)); + if (handler != 0) + INSTALL_HANDLER (SIGTSTP, handler); + } +} + +static void +describe_sighnd (int signo, unsigned char c) +{ + switch (encode_interrupt_handler (current_handler (signo))) + { + case interrupt_handler_control_g: + fputs ("When typed, scheme will get the ^G character interrupt.\n", + stdout); + fputs ("The default action is to abort the running program,\n", stdout); + fputs ("and to resume the top level read-eval-print loop.\n", stdout); + break; + case interrupt_handler_interactive: + fputs ("When typed, various interrupt options are offered.\n", stdout); + fprintf (stdout, "Type %s followed by `?' for a list of options.\n", + (char_description (c, 0))); + break; + case interrupt_handler_terminate: + describe_terminate: + fputs ("When typed, scheme will terminate.\n", stdout); + break; + case interrupt_handler_stop: + describe_stop: + fputs ("When typed, scheme will suspend execution.\n", stdout); + break; + case interrupt_handler_ignore: + describe_ignore: + fputs ("When typed, this character will be ignored.\n", stdout); + break; + case interrupt_handler_default: + { + struct signal_descriptor * descriptor = + (find_signal_descriptor (signo)); + if (descriptor != 0) + switch (descriptor -> action) + { + case dfl_ignore: goto describe_ignore; + case dfl_stop: goto describe_stop; + case dfl_terminate: goto describe_terminate; + } + } + default: + fputs ("When typed, this character will have an unknown effect.\n", + stdout); + break; + } +} + static void print_interrupt_chars (void) { @@ -886,24 +1015,20 @@ print_interrupt_chars (void) unsigned char quit_char = (OS_ctty_quit_char ()); fprintf (stdout, "\n\nThe quit character is %s.\n", (char_description (quit_char, 1))); - fputs ("When typed, various interrupt options are offered.\n", stdout); - fprintf (stdout, "Type %s followed by `?' for a list of options.\n", - (char_description (quit_char, 0))); + describe_sighnd (SIGQUIT, quit_char); } { unsigned char int_char = (OS_ctty_int_char ()); fprintf (stdout, "\nThe interrupt character is %s.\n", (char_description (int_char, 1))); - fputs ("When typed, scheme will get the ^G character interrupt.\n", stdout); - fputs ("The default action is to abort the running program,\n", stdout); - fputs ("and to resume the top level read-eval-print loop.\n", stdout); + describe_sighnd (SIGINT, int_char); } if (UX_SC_JOB_CONTROL ()) { unsigned char tstp_char = (OS_ctty_tstp_char ()); fprintf (stdout, "\nThe terminal stop character is %s.\n", (char_description (tstp_char, 1))); - fputs ("When typed, scheme will suspend execution.\n", stdout); + describe_sighnd (SIGTSTP, tstp_char); } putc ('\n', stdout); fflush (stdout); diff --git a/src/microcode/uxsig.h b/src/microcode/uxsig.h index fe0baf094..f420a5f1a 100644 --- a/src/microcode/uxsig.h +++ b/src/microcode/uxsig.h @@ -146,6 +146,4 @@ extern void ta_abort_handler (void *); #define record_signal_delivery(signo) #endif -extern void foreach_async_signal (void(*func)(int signo)); - #endif /* SCM_UXSIG_H */ diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index c7a5a87fb..7b1aa6d3f 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -302,7 +302,6 @@ USA. ;; inexact result exception) that the interrupted thread cares about. (%trace ";thread-timer: interrupt in "first-running-thread"\n") (let ((fp-env (enter-default-float-environment first-running-thread))) - (flo:set-environment! (flo:default-environment)) (set! next-scheduled-timeout #f) (set-interrupt-enables! interrupt-mask/gc-ok) (deliver-timer-events)