removed unused code, port to new FFI
This commit is contained in:
mainzelm
parent
07f9cbc6c9
commit
a2ec10935a
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -41,8 +41,7 @@
|
|||
|
||||
;;; Map a Unix async signal to its S48 interrupt value.
|
||||
;;; -1 => Not defined.
|
||||
(define-foreign %signal->interrupt (sig2interrupt (integer sig))
|
||||
integer)
|
||||
(define-stubless-foreign %signal->interrupt (sig) "sig2interrupt")
|
||||
|
||||
(define (signal->interrupt sig)
|
||||
(let ((int (%signal->interrupt sig)))
|
||||
|
|
@ -219,8 +218,7 @@
|
|||
;;; to our waiting parent proc correctly reflects how we died, and also
|
||||
;;; makes the core dump happen if it should. Details, details.
|
||||
|
||||
(define-foreign %do-default-sigaction (do_default_sigaction (fixnum signal))
|
||||
ignore)
|
||||
(define-stubless-foreign %do-default-sigaction (signal) "do_default_sigaction")
|
||||
|
||||
(define default-int-handler-vec
|
||||
;; Non-Unix-signal interrupts just get their default values from
|
||||
|
|
@ -236,18 +234,6 @@
|
|||
(%do-default-sigaction sig)))))))
|
||||
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
|
||||
;;; argument. The interrupt is delivered to a procedure by (1) setting the
|
||||
|
|
@ -286,51 +272,6 @@
|
|||
((eq? handler noop-sig-handler) #f)
|
||||
(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?)
|
||||
(do ((int 0 (+ int 1)))
|
||||
|
|
|
|||
|
|
@ -19,79 +19,14 @@
|
|||
|
||||
extern int errno;
|
||||
|
||||
// JMG: extern s48_value Spending_interruptsS, Sinterrupt_handlersS;
|
||||
|
||||
/* 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];
|
||||
}
|
||||
|
||||
|
||||
/* 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);
|
||||
}
|
||||
|
||||
int signal = s48_extract_fixnum (_signal);
|
||||
return s48_enter_fixnum (( signal < 0 || signal > max_sig ) ? -1 :
|
||||
sig2int[signal]);
|
||||
}
|
||||
|
||||
/* This guy is responsible for making the default action for a
|
||||
** 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.
|
||||
*/
|
||||
void do_default_sigaction(int signal)
|
||||
s48_value do_default_sigaction(s48_value _signal)
|
||||
{
|
||||
sigset_t ss, old_ss;
|
||||
struct sigaction default_action, old_action;
|
||||
|
||||
int signal = s48_extract_fixnum(_signal);
|
||||
/* fprintf(stderr, "Doing default for signal %d\n", signal); */
|
||||
|
||||
sigfillset(&ss); /* Block everyone. */
|
||||
|
|
@ -130,40 +65,13 @@ void do_default_sigaction(int signal)
|
|||
*/
|
||||
sigaction(signal, &old_action, 0); /* Restore old handler, */
|
||||
sigprocmask(SIG_SETMASK, &old_ss, 0); /* and mask. */
|
||||
}
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
|
||||
/* Set up the Unix signal system the way we want it for scsh. */
|
||||
|
||||
void install_scsh_handlers(void)
|
||||
s48_value s48_init_sighandlers(void)
|
||||
{
|
||||
struct sigaction new;
|
||||
int i;
|
||||
S48_EXPORT_FUNCTION(sig2interrupt);
|
||||
S48_EXPORT_FUNCTION(do_default_sigaction);
|
||||
|
||||
sigemptyset(&new.sa_mask); /* WTF */
|
||||
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;
|
||||
}
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,16 +1,5 @@
|
|||
/* 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);
|
||||
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);
|
||||
s48_value do_default_sigaction(s48_value signal);
|
||||
|
|
|
|||
Loading…
Reference in New Issue