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
/* 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);
}
return;
}
+\f
+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)
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 ();
+}
\f
static char
check_if_enabled (enum interrupt_handler handler)
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 */
(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);
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 */
\f
/* Select registry */
-select_registry_t
+static select_registry_t
arg_select_registry (int arg_number)
{
return ((select_registry_t) (arg_ulong_integer (arg_number)));
}
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);
+}
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);
return (ctty_fildes);
}
\f
+#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 */
+\f
static void
ctty_set_interrupt_chars (Tinterrupt_chars * ic)
{
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;
+}
\f
+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)
{
}
}
\f
+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);
+ }
+}
+\f
+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;
+ }
+}
+\f
static void
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);
#define record_signal_delivery(signo)
#endif
-extern void foreach_async_signal (void(*func)(int signo));
-
#endif /* SCM_UXSIG_H */
;; 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)
projects / mit-scheme.git / commitdiff