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

removed unused code, port to new FFI

This commit is contained in:
mainzelm 2001-01-01 17:49:08 +00:00
parent 07f9cbc6c9
commit a2ec10935a
4 changed files with 18 additions and 295 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
scsh/sighandlers.c
View File

@ -1,115 +0,0 @@
/* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0.
step 4
*/
#include <stdio.h>
#include <stdlib.h> /* For malloc. */
#include "libcig.h"
extern int errno;
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "sighandlers1.h"
s48_value df_sig2interrupt(s48_value g1)
{
extern int sig2interrupt(int );
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(1);
int r1;
S48_GC_PROTECT_1(ret1);
r1 = sig2interrupt(s48_extract_integer(g1));
ret1 = s48_enter_integer(r1);
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_do_default_sigaction(s48_value g1)
{
extern void do_default_sigaction(int );
do_default_sigaction(s48_extract_fixnum(g1));
return S48_FALSE;
}
s48_value df_scsh_set_sig(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec)
{
extern s48_value scsh_set_sig(int , int , int , int *, int *);
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(2);
s48_value r1;
int r2 = 0;
int r3 = 0;
S48_GC_PROTECT_2(mv_vec,ret1);
r1 = scsh_set_sig(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), &r2, &r3);
ret1 = r1;
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_scsh_get_sig(s48_value g1, s48_value mv_vec)
{
extern s48_value scsh_get_sig(int , int *, int *);
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(2);
s48_value r1;
int r2 = 0;
int r3 = 0;
S48_GC_PROTECT_2(mv_vec,ret1);
r1 = scsh_get_sig(s48_extract_fixnum(g1), &r2, &r3);
ret1 = r1;
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_install_scsh_handlers(void)
{
extern void install_scsh_handlers(void);
install_scsh_handlers();
return S48_FALSE;
}
s48_value df_get_int_handlers(void)
{
extern s48_value get_int_handlers(void);
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(1);
s48_value r1;
S48_GC_PROTECT_1(ret1);
r1 = get_int_handlers();
ret1 = r1;
S48_GC_UNPROTECT();
return ret1;
}
s48_value s48_init_sighandlers(void)
{
S48_EXPORT_FUNCTION(df_sig2interrupt);
S48_EXPORT_FUNCTION(df_do_default_sigaction);
S48_EXPORT_FUNCTION(df_scsh_set_sig);
S48_EXPORT_FUNCTION(df_scsh_get_sig);
S48_EXPORT_FUNCTION(df_install_scsh_handlers);
S48_EXPORT_FUNCTION(df_get_int_handlers);
return S48_UNSPECIFIC;
}

63
scsh/sighandlers.scm
View File

@ -41,8 +41,7 @@
;;; Map a Unix async signal to its S48 interrupt value. ;;; Map a Unix async signal to its S48 interrupt value.
;;; -1 => Not defined. ;;; -1 => Not defined.
(define-foreign %signal->interrupt (sig2interrupt (integer sig)) (define-stubless-foreign %signal->interrupt (sig) "sig2interrupt")
integer)
(define (signal->interrupt sig) (define (signal->interrupt sig)
(let ((int (%signal->interrupt sig))) (let ((int (%signal->interrupt sig)))
@ -219,8 +218,7 @@
;;; 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-foreign %do-default-sigaction (do_default_sigaction (fixnum signal)) (define-stubless-foreign %do-default-sigaction (signal) "do_default_sigaction")
ignore)
(define default-int-handler-vec (define default-int-handler-vec
;; Non-Unix-signal interrupts just get their default values from ;; Non-Unix-signal interrupts just get their default values from
@ -236,18 +234,6 @@
(%do-default-sigaction sig))))))) (%do-default-sigaction sig)))))))
v)) v))
;(define default-int-handler-vec
; (let ((v (make-vector interrupt-count)))
; (do ((sig 31 (- sig 1))) ; For each Unix signal
; ((< sig 0)) ; make & install a default
; (let ((i (%signal->interrupt sig))) ; signal handler.
; (vector-set! v i (if (>= i 0) ; Don't mess with non-signal interrupts.
; (if (memv sig signals-ignored-by-default)
; (lambda (enabled-interrupts) #f)
; (lambda (enabled-interrupts)
; (%do-default-sigaction sig)))
; 'default-s48-interrupt-action))))
; v))
;;; HANDLER is #f (ignore), #t (default), or a procedure taking an integer ;;; HANDLER is #f (ignore), #t (default), or a procedure taking an integer
;;; argument. The interrupt is delivered to a procedure by (1) setting the ;;; argument. The interrupt is delivered to a procedure by (1) setting the
@ -286,51 +272,6 @@
((eq? handler noop-sig-handler) #f) ((eq? handler noop-sig-handler) #f)
(else handler)))) (else handler))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Set the Unix signal handler. One doesn't usually use this; one usually
;;; uses the S48 VM's interrupt system.
;;; 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.
(define (%set-unix-signal-handler sig handler-code)
(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 old-flags)
(%%set-unix-signal-handler sig handler-code 0)
(cond ((not err) old-hc)
((= err errno/intr) (retry))
(else (errno-error err %set-unix-signal-handler sig handler-code))))))
(define-foreign %%set-unix-signal-handler
(scsh_set_sig (fixnum sig) (fixnum hc) (fixnum flags))
desc ; #f or errno
integer ; previous handler-code
integer) ; previous handler flags
(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
integer ; previous handler-code
integer) ; previous handler flags
(define-foreign %install-unix-scsh-handlers (install_scsh_handlers) ignore)
(define-foreign %%get-int-handlers (get_int_handlers) desc)
(define (%install-scsh-handlers interactive?) (define (%install-scsh-handlers interactive?)
(do ((int 0 (+ int 1))) (do ((int 0 (+ int 1)))

120
scsh/sighandlers1.c
View File

@ -19,79 +19,14 @@
extern int errno; extern int errno;
// JMG: extern s48_value Spending_interruptsS, Sinterrupt_handlersS;
/* Translate Unix signal numbers to S48 interrupt numbers. */ /* Translate Unix signal numbers to S48 interrupt numbers. */
int sig2interrupt(int signal) s48_value sig2interrupt(s48_value _signal)
{ {
return ( signal < 0 || signal > max_sig ) ? -1 : sig2int[signal]; int signal = s48_extract_fixnum (_signal);
} return s48_enter_fixnum (( signal < 0 || signal > max_sig ) ? -1 :
sig2int[signal]);
}
/* Set/Get signal handlers
*******************************************************************************
*/
static void scm_handle_sig(int sig)
{
/*fprintf(stderr, "scm_handle_sig(%d) = int %d\n", sig, sig2int[sig]);*/
//Spending_interruptsS |= (1<<sig2int[sig]);
fprintf(stderr, "scm_handle_sig was called with %d\n", sig);
}
/* handler_code: 0 => ignore, 1 => default, 2 => S48 VM */
/* Common code for two functions above. */
static s48_value scsh_ret_sig(int retval, struct sigaction *oldsa,
int *old_hc, int *oflags)
{
if( retval ) {
*old_hc = -1;
*oflags = -1;
return s48_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 = s48_enter_fixnum(3); /* Unknown signal handler. */
*oflags = oldsa->sa_flags;
return S48_FALSE;
}
s48_value scsh_set_sig(int sig, int handler_code, int flags,
int *old_hc, int *oflags)
{
struct sigaction new, old;
sigemptyset(&new.sa_mask); /* WTF */
new.sa_flags = flags;
switch( handler_code ) {
case 0: new.sa_handler = SIG_IGN; break;
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);
}
return scsh_ret_sig(sigaction(sig, &new, &old),
&old, old_hc, oflags);
}
s48_value scsh_get_sig(int signal, int *old_hc, int *oflags)
{
struct sigaction old;
return scsh_ret_sig(sigaction(signal, NULL, &old),
&old, old_hc, oflags);
}
/* 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
@ -106,11 +41,11 @@ s48_value scsh_get_sig(int signal, int *old_hc, int *oflags)
** **
** Weird, I know. ** Weird, I know.
*/ */
void do_default_sigaction(int signal) s48_value do_default_sigaction(s48_value _signal)
{ {
sigset_t ss, old_ss; sigset_t ss, old_ss;
struct sigaction default_action, old_action; struct sigaction default_action, old_action;
int signal = s48_extract_fixnum(_signal);
/* fprintf(stderr, "Doing default for signal %d\n", signal); */ /* fprintf(stderr, "Doing default for signal %d\n", signal); */
sigfillset(&ss); /* Block everyone. */ sigfillset(&ss); /* Block everyone. */
@ -130,40 +65,13 @@ void do_default_sigaction(int signal)
*/ */
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. */
} return S48_UNSPECIFIC;
}
s48_value s48_init_sighandlers(void)
/* Set up the Unix signal system the way we want it for scsh. */
void install_scsh_handlers(void)
{ {
struct sigaction new; S48_EXPORT_FUNCTION(sig2interrupt);
int i; S48_EXPORT_FUNCTION(do_default_sigaction);
sigemptyset(&new.sa_mask); /* WTF */ return S48_UNSPECIFIC;
new.sa_handler = scm_handle_sig; }
new.sa_flags = 0;
for(i=max_sig; i>=0; i--)
if( ( i != SIGINT ) && 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. */
s48_value get_int_handlers(void)
{
fprintf(stderr,"get_int_handlers return 1 instead of Sinterrupt_handlersS ");
//return Sinterrupt_handlersS;
return 1;
}

15
scsh/sighandlers1.h
View File

@ -1,16 +1,5 @@
/* Exports from sighandlers1.c */ /* Exports from sighandlers1.c */
int sig2interrupt(int signal); s48_value sig2interrupt(s48_value signal);
int set_procmask(int hi, int lo, int *old_lo_p); s48_value do_default_sigaction(s48_value signal);
int get_procmask(int *old_lo_p);
s48_value scsh_set_sig(int sig, int handler_code, int flags,
int *ohc, int *oflags);
s48_value scsh_get_sig(int signal, int *handler_code, int *flags);
void do_default_sigaction(int signal);
void install_scsh_handlers(void);
s48_value get_int_handlers(void);