scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Sig-handler support

This commit is contained in:
shivers 1996-09-12 04:34:28 +00:00
parent 0716fc06cd
commit b48e4874c5
4 changed files with 220 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
scsh/scsh_aux.h
View File

@ -5,3 +5,31 @@
#define Malloc(type,n) ((type *) malloc(sizeof(type)*(n))) #define Malloc(type,n) ((type *) malloc(sizeof(type)*(n)))
#define Free(p) (free((char *)(p))) #define Free(p) (free((char *)(p)))
#define Realloc(type,p,n) ((type *) realloc(p, (n)*sizeof(type))) #define Realloc(type,p,n) ((type *) realloc(p, (n)*sizeof(type)))
/* These are the interrupt numbers used by the S48/scsh VM.
** The first three are S48 interrupts. The rest were added for
** scsh to support Unix signals. Note that not all Unixes support
** all these signals.
*/
#define scshint_alarm (0) /* S48 Unix SIGALRM signal */
#define scshint_keyboard (1) /* S48 Unix SIGINT signal */
#define scshint_memory_shortage (2)
#define scshint_chld (3) /* Interrupts from here down are */
#define scshint_cont (4) /* Unix signals. The last ten are */
#define scshint_hup (5) /* non-Posix, hence not necessarily */
#define scshint_quit (6) /* found on all Unixes. */
#define scshint_term (7)
#define scshint_tstp (8)
#define scshint_usr1 (9)
#define scshint_usr2 (10)
#define scshint_info (11) /* BSD */
#define scshint_io (12) /* BSD + SVR4 */
#define scshint_poll (13) /* SVR4 */
#define scshint_prof (14) /* BSD + SVR4 */
#define scshint_pwr (15) /* SVR4 */
#define scshint_urg (16) /* BSD + SVR4 */
#define scshint_vtalrm (17) /* BSD + SVR4 */
#define scshint_winch (18) /* BSD + SVR4 */
#define scshint_xcpu (19) /* BSD + SVR4 */
#define scshint_xfsz (20) /* BSD + SVR4 */

170
scsh/sighandlers.scm
View File

@ -5,6 +5,10 @@
;;; *through* an intermediate interface, the S48 vm's idea of interrupts. ;;; *through* an intermediate interface, the S48 vm's idea of interrupts.
;;; So there is a difference between delivering a signal to the underlying ;;; So there is a difference between delivering a signal to the underlying
;;; Unix process and delivering it to the program that runs on the VM. ;;; Unix process and delivering it to the program that runs on the VM.
;;;
;;; One effect is that we have two separate codes for the same thing -- the
;;; Unix signal code, and the S48 interrupt value. E.g., SIGNAL/TSTP and
;;; INTERRUPT/TSTP.
;;; These system calls can return EINTR or restart. In order for the S48 vm's ;;; These system calls can return EINTR or restart. In order for the S48 vm's
;;; interrupt system to detect a signal and invoke the handler, they *must* ;;; interrupt system to detect a signal and invoke the handler, they *must*
@ -20,6 +24,11 @@
;;; HP-UX, but I don't use: poll lockf msem_lock msgsnd msgrcv semop ;;; HP-UX, but I don't use: poll lockf msem_lock msgsnd msgrcv semop
;;; ;;;
;;; * Only during a F_SETLKW ;;; * Only during a F_SETLKW
;;;
;;; From rts/interrupt.scm (package interrupts, interface interrupts-interface)
;;; WITH-INTERRUPTS INTERRUPT-HANDLERS SET-ENABLED-INTERRUPTS!
;;; ENABLED-INTERRUPTS
;;; Must define WITH-INTERRUPTS* and WITH-INTERRUPTS.
(foreign-source (foreign-source
"extern int errno;" "extern int errno;"
@ -28,10 +37,16 @@
"#include \"sighandlers1.h\"" "#include \"sighandlers1.h\""
"" "") "" "")
;;; Blocking interrupts ;;; Map a Unix async signal to its S48 interrupt value.
;;; I think all of this code (and associated C code) has been obsoleted by ;;; -1 => Not defined.
;;; the new system that uses S48's sigblocking machinery. (define-foreign %signal->interrupt (sig2interrupt (integer sig))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; integer)
(define (signal->interrupt sig)
(let ((int (%signal->interrupt sig)))
(if (>= int 0) int
(error "Unix signal has no Scheme 48 interrupt." sig))))
(define (interrupt-set . interrupts) (define (interrupt-set . interrupts)
(let lp ((ints interrupts) (ans 0)) (let lp ((ints interrupts) (ans 0))
@ -39,33 +54,10 @@
(lp (cdr ints) (bitwise-ior ans (arithmetic-shift 1 (- (car ints) 1)))) (lp (cdr ints) (bitwise-ior ans (arithmetic-shift 1 (- (car ints) 1))))
ans))) ans)))
(define-simple-syntax (with-blocked-interrupts mask body ...) (define-simple-syntax (with-enabled-interrupts mask body ...)
(with-blocked-interrupts* mask (lambda () body ...))) (with-interrupts mask (lambda () body ...)))
(define (with-blocked-interrupts* mask thunk) (define with-enabled-interrupts* with-interrupts)
(let ((old-mask #f))
(dynamic-wind
(lambda () (set! old-mask (set-blocked-interrupts! mask)))
thunk
(lambda () (set-blocked-interrupts! old-mask)))))
(define (set-blocked-interrupts! mask)
(receive (hi-out lo-out)
(%set-blocked-interrupts! (hi8 mask) (lo24 mask))
(compose-8/24 hi-out lo-out)))
(define (blocked-interrupts)
(call-with-values %blocked-interrupts compose-8/24))
(define-foreign %set-blocked-interrupts! (set_procmask (fixnum hi)
(fixnum lo))
fixnum ; hi
fixnum) ; lo
(define-foreign %blocked-interrupts (get_procmask)
fixnum ; hi
fixnum) ; lo
;;; Get/Set signal handlers ;;; Get/Set signal handlers
@ -81,62 +73,90 @@
;;; to our waiting parent proc correctly reflects how we died, and also ;;; to our waiting parent proc correctly reflects how we died, and also
;;; makes the core dump happen if it should. Details, details. ;;; makes the core dump happen if it should. Details, details.
(define (default-handler sig)
(lambda (enabled-interrupts) (%do-default-sigaction sig)))
(define-foreign %do-default-sigaction (do_default_sigaction (fixnum signal)) (define-foreign %do-default-sigaction (do_default_sigaction (fixnum signal))
ignore) ignore)
;;; This gives the default handler for each signal.
(define default-handler-vec
(initialize-vector 32 (lambda (sig)
;; This is the guy to call when you want signal
;; SIG handled in the default manner.
(if (memv sig signals-ignored-by-default)
(lambda (enabled-interrupts) #f)
(lambda (enabled-interrupts)
(%do-default-sigaction sig))))))
;;; HANDLER is #f (ignore), #t (default), or an integer procedure.
;;; The interrupt is delivered to a procedure by (1) setting the
;;; ENABLED-INTERRUPTS register to 0 (i.e., blocking all interrupts),
;;; and (2) applying the procedure to the previous value of the
;;; ENABLED-INTERRUPTS register. If the procedure returns normally
;;; (i.e., it doesn't throw to a continuation), the ENABLED-INTERRUPTS
;;; register will be restored to its previous value.
;;; Should have extra args, MASK & FLAGS. ;;; HANDLER is #f (ignore), #t (default), or a procedure taking an integer
(define (set-signal-handler sig handler) ;;; argument. The interrupt is delivered to a procedure by (1) setting the
(let ((handler (if (eq? handler #t) ; Hack the default handler. ;;; ENABLED-INTERRUPTS register to 0 (i.e., blocking all interrupts), and (2)
(default-handler sig) ;;; applying the procedure to the previous value of the ENABLED-INTERRUPTS
handler))) ;;; register. If the procedure returns normally (i.e., it doesn't throw to a
(receive (handler flags) ; Should be (handler mask flags). ;;; continuation), the ENABLED-INTERRUPTS register will be restored to its
(%set-signal-handler! sig handler 0) ;;; previous value.
handler)))
(define (set-signal-handler! sig handler)
(let ((nhandler (if (eq? handler #t) ; Get SIG's default handler.
(vector-ref default-handler-vec sig)
handler))
(int (signal->interrupt sig)))
(with-enabled-interrupts 0
(let ((ohandler (vector-ref interrupt-handlers int)))
(vector-set! interrupt-handlers int nhandler)
ohandler))))
(define (signal-handler sig) (define (signal-handler sig)
(receive (handler flags) (%signal-handler sig) (vector-ref interrupt-handlers (signal->interrupt sig)))
handler))
(define (%signal-handler sig) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(receive (err handler flags) (%%signal-handler sig) ;;; Set the Unix signal handler. One doesn't usually use this; one usually
(if err (errno-error err %signal-handler sig) ;;; uses the S48 VM's interrupt system.
(values handler flags)))) ;;; HANDLER-CODE: 0 => ignore, 1 => default, 2 => S48 VM
;;; Returns equivalent code, additionally 3 => other handler.
;;; Raises an error exception if there's a problem.
;;; (%set-signal-handler! sig handler [mask flags]) -> [handler mask flags] (define (%set-unix-signal-handler! sig handler-code)
;;; Except no MASK for now. (check-arg (lambda (x) (and (integer? sig) (< 0 sig 32)))
sig
%set-unix-signal-handler!)
(check-arg (lambda (x) (and (integer? handler-code) (<= 0 handler-code 2)))
handler-code
%set-unix-signal-handler!)
(let retry ()
(receive (err old-hc) (%%set-unix-signal-handler! sig handler-code)
(cond ((not err) old-hc)
((= err errno/intr) (retry))
(else (errno-error err %set-unix-signal-handler! sig handler-code))))))
(define (%set-signal-handler! sig handler . args) (define-foreign %%set-unix-signal-handler!
(let-optionals args ((flags 0)) (scsh_set_sig (fixnum sig) (fixnum hc) (fixnum flags))
(receive (err handler flags)
(%%set-signal-handler! sig handler flags)
(if err
(errno-error err %set-signal-handler! sig handler flags)
(values handler flags)))))
(define-foreign %%set-signal-handler! (set_sig_handler (fixnum signal)
(desc handler)
(fixnum flags))
desc ; #f or errno desc ; #f or errno
desc ; handler integer ; previous handler-code
fixnum) ; flags integer) ; previous handler flags
(define-foreign %%signal-handler (get_sig_handler (fixnum signal)) (define (%unix-signal-handler sig)
(check-arg (lambda (x) (and (integer? sig) (< 0 sig 32)))
sig
%unix-signal-handler)
(let retry ()
(receive (err hc flags) (%%unix-signal-handler sig)
(cond ((not err) hc)
((= err errno/intr) (retry))
(else (errno-error err %unix-signal-handler sig))))))
(define-foreign %%unix-signal-handler (scsh_get_sig (fixnum sig))
desc ; #f or errno desc ; #f or errno
desc ; handler integer ; previous handler-code
fixnum) ; flags integer) ; previous handler flags
(define-foreign %%install-new-handler-vec (define-foreign %install-unix-scsh-handlers (install_scsh_handlers) ignore)
(install_new_handler_vector (vector-desc vec))
ignore) (define-foreign %%get-int-handlers (get_int_handlers) desc)
(define (%install-scsh-handlers)
(do ((sig 32 (- sig 1)))
((< sig 0))
(let ((i (%signal->interrupt sig)))
(if (not (or (= i -1) (= sig signal/int) (= sig signal/alrm)))
(vector-set! interrupt-handlers i
(vector-ref default-handler-vec sig))))))

277
scsh/sighandlers1.c
View File

@ -6,66 +6,25 @@
#include <unistd.h> #include <unistd.h>
#include <sys/types.h> #include <sys/types.h>
#include <signal.h> #include <signal.h>
#include <stdio.h>
#include "cstuff.h" #include "cstuff.h"
/* Make sure our exports match up w/the implementation: */ /* Make sure our exports match up w/the implementation: */
#include "sighandlers1.h" #include "sighandlers1.h"
#include "machine/signals1.h"
extern int errno; extern int errno;
extern scheme_value Spending_interruptsS, Sinterrupt_handlersS; extern scheme_value Spending_interruptsS, Sinterrupt_handlersS;
/* Translate Unix signal numbers to S48 interrupt numbers. /* Translate Unix signal numbers to S48 interrupt numbers. */
** alarm, keyboard (^C, SIGINT), and memory shortage are 0, 1, and 2.
*/
static int sig2interrupt(int signal) int sig2interrupt(int signal)
{ {
switch (signal) { return ( signal < 0 || signal > max_sig ) ? -1 : sig2int[signal];
case SIGALRM: return 0; /* Already defined by S48. */
case SIGCHLD: return 3;
case SIGCONT: return 4;
case SIGHUP: return 5;
case SIGINT: return 1; /* Already defined by S48. */
case SIGQUIT: return 6;
case SIGTERM: return 7;
case SIGTSTP: return 8;
case SIGUSR1: return 9;
case SIGUSR2: return 10;
#ifdef SIGINFO
case SIGINFO: return 11;
#endif
#ifdef SIGIO
case SIGIO: return 12;
#endif
#ifdef SIGPOLL
case SIGPOLL: return 13;
#endif
#ifdef SIGPROF
case SIGPROF: return 14;
#endif
#ifdef SIGPWR
case SIGPWR: return 15;
#endif
#ifdef SIGURG
case SIGURG: return 16;
#endif
#ifdef SIGVTALRM
case SIGVTALRM: return 17;
#endif
#ifdef SIGWINCH
case SIGWINCH: return 18;
#endif
#ifdef SIGXCPU
case SIGXCPU: return 19;
#endif
#ifdef SIGXFSZ
case SIGXFSZ: return 20;
#endif
default: return -1;
} }
}
/* Hack the blocked-signal mask. /* Hack the blocked-signal mask.
******************************************************************************* *******************************************************************************
@ -104,138 +63,63 @@ int get_procmask(int *old_lo_p)
static void scm_handle_sig(int sig) static void scm_handle_sig(int sig)
{ {
Spending_interruptsS |= (1<<sig2interrupt(sig)); fprintf(stderr, "scm_handle_sig(%d)\n", sig);
Spending_interruptsS |= (1<<sig2int[sig]);
} }
scheme_value set_sig_handler(int sig, scheme_value handler, int flags, /* handler_code: 0 => ignore, 1 => default, 2 => S48 VM */
scheme_value *ohandler, int *oflags)
/* Common code for two functions above. */
static scheme_value scsh_ret_sig(int retval, struct sigaction *oldsa,
int *old_hc, int *oflags)
{
if( retval ) {
*old_hc = -1;
*oflags = -1;
return ENTER_FIXNUM(errno);
}
if( oldsa->sa_handler == SIG_IGN ) *old_hc = 0;
else if( oldsa->sa_handler == SIG_DFL ) *old_hc = 1;
else if( oldsa->sa_handler == scm_handle_sig ) *old_hc = 2;
else *old_hc = ENTER_FIXNUM(3); /* Unknown signal handler. */
*oflags = oldsa->sa_flags;
return SCHFALSE;
}
scheme_value scsh_set_sig(int sig, int handler_code, int flags,
int *old_hc, int *oflags)
{ {
struct sigaction new, old; struct sigaction new, old;
int intnum = sig2interrupt(sig);
scheme_value old_scsh_handler;
/* intnum in range? */
if( intnum >= VECTOR_LENGTH(Sinterrupt_handlersS) ) {
*ohandler = SCHFALSE;
return ENTER_FIXNUM(-1);
}
/* We may need this for ohandler later, but it may get clobbered
** when we set the new handler, so stash it away for now.
*/
old_scsh_handler = VECTOR_REF(Sinterrupt_handlersS, intnum);
sigemptyset(&new.sa_mask); /* WTF */ sigemptyset(&new.sa_mask); /* WTF */
new.sa_flags = flags; new.sa_flags = flags;
if( handler == SCHFALSE ) { switch( handler_code ) {
new.sa_handler = SIG_IGN; case 0: new.sa_handler = SIG_IGN; break;
VECTOR_REF(Sinterrupt_handlersS, intnum) = SCHFALSE; case 1: new.sa_handler = SIG_DFL; break;
} case 2: new.sa_handler = scm_handle_sig; break;
default:
fprintf(stderr, "Impossible handler_code in set_sig_handler: %d\n",
handler_code);
exit(-1);
}
/* This *really* sets the Unix signal handler to SIG_DFL. return scsh_ret_sig(sigaction(sig, &new, &old),
** What usually happens isn't this -- what usually happens is that &old, old_hc, oflags);
** we establish a special Scheme handler that does the default, so
** that it is subject to S48's blocking machinery.
*/
else if( handler == SCHTRUE ) {
new.sa_handler = SIG_DFL;
VECTOR_REF(Sinterrupt_handlersS, intnum) = SCHFALSE;
}
else {
new.sa_handler = scm_handle_sig;
VECTOR_REF(Sinterrupt_handlersS, intnum) = handler;
/* Do other stuff. */
}
if( sigaction(sig, &new, &old) ) {
*ohandler = SCHFALSE;
return ENTER_FIXNUM(errno);
}
*oflags = old.sa_flags;
if( old.sa_handler == SIG_IGN ) *ohandler = SCHFALSE;
else if( old.sa_handler == SIG_DFL ) *ohandler = SCHTRUE;
else if( old.sa_handler == scm_handle_sig ) *ohandler = old_scsh_handler;
else *ohandler = ENTER_FIXNUM(-1); /* Unknown signal handler. */
return SCHFALSE;
} }
scheme_value get_sig_handler(int signal, scheme_value *handler, int *flags) scheme_value scsh_get_sig(int signal, int *old_hc, int *oflags)
{ {
struct sigaction old; struct sigaction old;
return scsh_ret_sig(sigaction(signal, NULL, &old),
if( sigaction(signal, NULL, &old) ) { &old, old_hc, oflags);
*handler = SCHFALSE;
return ENTER_FIXNUM(errno);
}
*flags = old.sa_flags;
if( old.sa_handler == SIG_IGN ) *handler = SCHFALSE;
else if( old.sa_handler == SIG_DFL ) *handler = SCHTRUE;
else if( old.sa_handler == scm_handle_sig ) {
int intnum = sig2interrupt(signal);
/* intnum in range? */
if( intnum >= VECTOR_LENGTH(Sinterrupt_handlersS) ) {
*handler = SCHFALSE;
return ENTER_FIXNUM(-1);
}
*handler = VECTOR_REF(Sinterrupt_handlersS, intnum);
}
else *handler = ENTER_FIXNUM(-1); /* Unknown signal handler. */
return SCHFALSE;
} }
/* Return true if SIGNAL's default action is definitely to be ignored. */
/* This should be inlined by a good compiler. */
static int sig_def_is_ignored(int signal)
{
return
/* Posix signals */
signal == SIGALRM || signal == SIGHUP ||
signal == SIGINT || signal == SIGQUIT ||
signal == SIGTERM || signal == SIGUSR1 ||
signal == SIGUSR2
/* Non-Posix signals, when present. */
#ifdef SIGINFO
|| signal == SIGINFO
#endif
#ifdef SIGPOLL
|| signal == SIGPOLL
#endif
#ifdef SIGPROF
|| signal == SIGPROF
#endif
#ifdef SIGVTALRM
|| signal == SIGVTALRM
#endif
#ifdef SIGXCPU
|| signal == SIGXCPU
#endif
#ifdef SIGXFSZ
|| signal == SIGXFSZ
#endif
#ifdef SIGIO
|| signal == SIGIO /* BSD => ignore; SVR4 => terminate */
#endif
;
}
/* This guy is responsible for making the default action for a /* This guy is responsible for making the default action for a
** Unix signal happen. Because S48's signal handler system is ** Unix signal happen. Because S48's signal handler system is
** interposed between delivery-to-the-process and ** interposed between delivery-to-the-process and
@ -254,39 +138,56 @@ void do_default_sigaction(int signal)
sigset_t ss, old_ss; sigset_t ss, old_ss;
struct sigaction default_action, old_action; struct sigaction default_action, old_action;
if( !sig_def_is_ignored(signal) ) { fprintf(stderr, "Doing default for signal %d\n", signal);
/* OK -- signal's default *isn't* "ignore," so we have to do it. */ sigfillset(&ss); /* Block everyone. */
sigfillset(&ss); /* Block everyone. */ sigprocmask(SIG_SETMASK, &ss, &old_ss);
sigprocmask(SIG_SETMASK, &ss, &old_ss);
default_action.sa_handler = SIG_DFL; /* Set for default. */ default_action.sa_handler = SIG_DFL; /* Set for default. */
sigemptyset(&default_action.sa_mask); sigemptyset(&default_action.sa_mask);
default_action.sa_flags = 0; default_action.sa_flags = 0;
sigaction(signal, &default_action, &old_action); sigaction(signal, &default_action, &old_action);
raise(signal); /* Raise the signal. */ raise(signal); /* Raise the signal. */
sigdelset(&ss, signal); sigdelset(&ss, signal);
sigprocmask(SIG_SETMASK, &ss, 0); /* Handle it. */ sigprocmask(SIG_SETMASK, &ss, 0); /* Handle it. */
/* Most likely, we'll never get to here, as the default for /* Most likely, we'll never get to here, as the default for
** the signals we're handling is "terminate," but we'll play it safe. ** the signals we're handling is "terminate," but we'll play it safe.
*/ */
sigaction(signal, &old_action, 0); /* Restore old handler, */ sigaction(signal, &old_action, 0); /* Restore old handler, */
sigprocmask(SIG_SETMASK, &old_ss, 0); /* and mask. */ sigprocmask(SIG_SETMASK, &old_ss, 0); /* and mask. */
}
} }
/* Install a new signal-handler vector. /* Set up the Unix signal system the way we want it for scsh. */
** I use this because the default one is only 3 entries long, and I
** don't want to modify the S48 source. So I'll just install my own
** at run-time.
** It's not a hack, it's a kluge.
*/
void install_new_handler_vector(scheme_value handlers) void install_scsh_handlers(void)
{ {
extern scheme_value Sinterrupt_handlersS; struct sigaction new;
Sinterrupt_handlersS = handlers; int i;
sigemptyset(&new.sa_mask); /* WTF */
new.sa_handler = scm_handle_sig;
for(i=max_sig; i>=0; i--)
if( sig2int[i] ) {
/* This is a signal we want the S48 interrupt system to handle. */
sigaction(i, &new, 0);
}
/* Turn off SIGPIPE and SIGSYS -- they are handled by synchronous exceptions
** triggered by errno returns.
*/
new.sa_handler = SIG_IGN;
sigaction(SIGPIPE, &new, 0);
#ifdef SIGSYS
sigaction(SIGSYS, &new, 0);
#endif
}
/* Sneak me the S48 interrupt handlers vector. */
scheme_value get_int_handlers(void)
{
return Sinterrupt_handlersS;
} }

12
scsh/sighandlers1.h
View File

@ -1,12 +1,16 @@
/* Exports from sighandlers1.c */ /* Exports from sighandlers1.c */
int sig2interrupt(int signal);
int set_procmask(int hi, int lo, int *old_lo_p); int set_procmask(int hi, int lo, int *old_lo_p);
int get_procmask(int *old_lo_p); int get_procmask(int *old_lo_p);
scheme_value set_int_handler(int sig, scheme_value handler, int flags, scheme_value scsh_set_sig(int sig, int handler_code, int flags,
scheme_value *ohandler, int *oflags); int *ohc, int *oflags);
scheme_value get_int_handler(int signal, scheme_value *handler, int *flags); scheme_value scsh_get_sig(int signal, int *handler_code, int *flags);
void do_default_sigaction(int signal); void do_default_sigaction(int signal);
void install_new_handler_vector(scheme_value handlers); void install_scsh_handlers(void);
scheme_value get_int_handlers(void);