removed obsolete files/code for jcontrol and signal sets
This commit is contained in:
mainzelm
parent
747dfe20df
commit
6c136b907d
|
|
@ -1,10 +0,0 @@
|
|||
/* Convert between a lo24/hi integer-pair bitset and a sigset_t value.
|
||||
** These macros are OS-dependent, and must be defined per-OS.
|
||||
*/
|
||||
|
||||
#define make_sigset(maskp, hi, lo) ((maskp)->losigs=((hi)<<24)|(lo))
|
||||
|
||||
/* Not a procedure: */
|
||||
#define split_sigset(mask, hip, lop) \
|
||||
((*(hip)=(mask.losigs>>24)&0xff), \
|
||||
(*(lop)=(mask.losigs&0xffffff)))
|
||||
|
|
@ -1,19 +0,0 @@
|
|||
/* Convert between a lo24/hi integer-pair bitset and a sigset_t value.
|
||||
** These macros are OS-dependent, and must be defined per-OS.
|
||||
*/
|
||||
#include <sys/param.h>
|
||||
#if defined __FreeBSD_version && __FreeBSD_version > 400000
|
||||
#define make_sigset(maskp, hi, lo)(*maskp.__bits[0] = ((hi)<<24)|(lo))
|
||||
|
||||
/* Not a procedure: */
|
||||
#define split_sigset(mask, hip, lop) \
|
||||
((*(hip)=(mask.__bits[0]>>24)&0xff), \
|
||||
(*(lop)=(mask.__bits[0]&0xffffff)))
|
||||
#else
|
||||
#define make_sigset(maskp, hi, lo) (*maskp=((hi)<<24)|(lo))
|
||||
|
||||
/* Not a procedure: */
|
||||
#define split_sigset(mask, hip, lop) \
|
||||
((*(hip)=(mask>>24)&0xff), \
|
||||
(*(lop)=(mask&0xffffff)))
|
||||
#endif
|
||||
|
|
@ -1,64 +0,0 @@
|
|||
;;; Copyright (c) 1993 by Olin Shivers.
|
||||
;;; Job control code.
|
||||
|
||||
;;; Fork off a process that runs in its own process group. The process
|
||||
;;; is (1) placed in its own process group and (2) suspended before
|
||||
;;; the process's actual work code is executed, and before FORK-JOB
|
||||
;;; returns to the parent. The next time the job is resumed, it will
|
||||
;;; begin its actual work.
|
||||
|
||||
(define (fork-job . maybe-thunk)
|
||||
(let ((child (fork)))
|
||||
|
||||
(cond (child
|
||||
;; PARENT -- wait for child to stop and then set its proc group.
|
||||
(let ((status (wait child wait/stopped-children)))
|
||||
(if (not (status:stop-sig status)) ; Make sure it didn't die.
|
||||
(error "premature job death" status))) ; error call right?
|
||||
(set-process-group child child))
|
||||
|
||||
;; CHILD -- suspend until we are put in our own proc group.
|
||||
;; The test&suspend isn't atomic; the parent needs to do things
|
||||
;; in the right order to make this win.
|
||||
(else (let lp ()
|
||||
(signal-process 0 signal/stop)
|
||||
(if (not (= (pid) (process-group))) (lp)))
|
||||
|
||||
(if (pair? maybe-thunk)
|
||||
(call-terminally (car maybe-thunk)))))
|
||||
|
||||
child))
|
||||
|
||||
|
||||
;;; Foreground a suspended or running background job.
|
||||
|
||||
(define (resume-job proc-group)
|
||||
(set-terminal-proc-group 0 proc-group) ; Give tty to job.
|
||||
(signal-process-group proc-group signal/cont)
|
||||
(let ((status (wait proc-group wait/stopped-children)))
|
||||
(set-terminal-proc-group 0 (process-group)) ; Take tty back.
|
||||
status))
|
||||
|
||||
;;; What if stdin (fd 0) isn't a tty? Need a (control-tty)
|
||||
;;; or (control-tty-fdes) procedure.
|
||||
|
||||
|
||||
;;; Background a suspended job.
|
||||
|
||||
(define (background-job proc-group)
|
||||
(signal-process-group proc-group signal/cont)
|
||||
proc-group)
|
||||
|
||||
|
||||
(define-simple-syntax (run . epf)
|
||||
(resume-job (fork-job (lambda () (exec-epf . epf)))))
|
||||
|
||||
(define-simple-syntax (& . epf)
|
||||
(background-job (fork-job (lambda () (exec-epf . epf)))))
|
||||
|
||||
|
||||
;;; Need repl loop that manages some kind of a job table,
|
||||
;;; and grabs the terminal back after running a job.
|
||||
;;; Should I define a WAIT-JOB procedure?
|
||||
;;; Need a (CONTROL-TTY) procedure.
|
||||
|
||||
|
|
@ -1,97 +0,0 @@
|
|||
/* This code is all obsolete & should be thrown away. 8/23/96 Olin. */
|
||||
|
||||
#include <unistd.h>
|
||||
#include <sys/types.h>
|
||||
#include <signal.h>
|
||||
#include "cstuff.h"
|
||||
|
||||
extern int errno;
|
||||
|
||||
/* Hack the blocked-signal mask.
|
||||
*******************************************************************************
|
||||
*/
|
||||
|
||||
|
||||
#include "machine/sigset.h"
|
||||
|
||||
int set_procmask(int hi, int lo, int *old_lo_p)
|
||||
{
|
||||
sigset_t mask, old_mask;
|
||||
int old_hi;
|
||||
|
||||
make_sigset(&mask, hi, lo);
|
||||
|
||||
sigprocmask(SIG_SETMASK, &mask, &old_mask);
|
||||
split_sigset(old_mask, &old_hi, old_lo_p);
|
||||
return old_hi;
|
||||
}
|
||||
|
||||
|
||||
int get_procmask(int *old_lo_p)
|
||||
{
|
||||
sigset_t old_mask;
|
||||
int old_hi;
|
||||
|
||||
sigprocmask(SIG_SETMASK, NULL, &old_mask);
|
||||
split_sigset(old_mask, &old_hi, old_lo_p);
|
||||
return old_hi;
|
||||
}
|
||||
|
||||
|
||||
/* Set/Get signal handlers
|
||||
*******************************************************************************
|
||||
*/
|
||||
|
||||
long int pending_signals = 0;
|
||||
void scm_handle_sig(int sig) {pending_signals |= (1<<sig);}
|
||||
|
||||
|
||||
s48_value set_int_handler(int sig, s48_value handler, int flags,
|
||||
s48_value *ohandler, int *oflags)
|
||||
{
|
||||
struct sigaction new, old;
|
||||
|
||||
sigemptyset(&new.sa_mask); /* WTF */
|
||||
new.sa_flags = flags;
|
||||
|
||||
if( handler == S48_FALSE ) new.sa_handler = SIG_IGN;
|
||||
else if( handler == S48_TRUE ) new.sa_handler = SIG_DFL;
|
||||
else {
|
||||
new.sa_handler = scm_handle_sig;
|
||||
/* Do other stuff. */
|
||||
}
|
||||
|
||||
if( sigaction(sig, &new, &old) ) {
|
||||
*ohandler = S48_FALSE;
|
||||
return s48_enter_fixnum(errno);
|
||||
}
|
||||
|
||||
*oflags = old.sa_flags;
|
||||
/* if( old.sa_handler == SIG_IGN ) *ohandler = S48_FALSE;
|
||||
else if( old.sa_handler == SIG_DFL ) *ohandler = S48_TRUE;
|
||||
else if( old.sa_handler == scm_handle_sig ) {
|
||||
*ohandler = s48_enter_fixnum(0); /* Fix later. */
|
||||
}
|
||||
else *ohandler = s48_enter_fixnum(-1); /* Unknown signal handler. */
|
||||
return S48_FALSE;
|
||||
}
|
||||
|
||||
|
||||
s48_value get_int_handler(int signal, s48_value *handler, int *flags)
|
||||
{
|
||||
struct sigaction old;
|
||||
|
||||
if( sigaction(signal, NULL, &old) ) {
|
||||
*handler = S48_FALSE;
|
||||
return s48_enter_fixnum(errno);
|
||||
}
|
||||
|
||||
*flags = old.sa_flags;
|
||||
if( old.sa_handler == SIG_IGN ) *handler = S48_FALSE;
|
||||
else if( old.sa_handler == SIG_DFL ) *handler = S48_TRUE;
|
||||
else if( old.sa_handler == scm_handle_sig ) {
|
||||
*handler = s48_enter_fixnum(0); /* Fix later. */
|
||||
}
|
||||
else *handler = s48_enter_fixnum(-1); /* Unknown signal handler. */
|
||||
return S48_FALSE;
|
||||
}
|
||||
|
|
@ -1,76 +0,0 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by cig.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h> /* For malloc. */
|
||||
#include "libcig.h"
|
||||
|
||||
#include <sys/signal.h>
|
||||
#include <sys/types.h>
|
||||
#include <unistd.h>
|
||||
|
||||
extern int errno;
|
||||
|
||||
#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)
|
||||
|
||||
scheme_value df_set_procmask(long nargs, scheme_value *args)
|
||||
{
|
||||
extern int set_procmask(int , int , int *);
|
||||
scheme_value ret1;
|
||||
int r1;
|
||||
int r2;
|
||||
|
||||
cig_check_nargs(3, nargs, "set_procmask");
|
||||
r1 = set_procmask(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2);
|
||||
ret1 = ENTER_FIXNUM(r1);
|
||||
VECTOR_REF(*args,0) = ENTER_FIXNUM(r2);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
scheme_value df_get_procmask(long nargs, scheme_value *args)
|
||||
{
|
||||
extern int get_procmask(int *);
|
||||
scheme_value ret1;
|
||||
int r1;
|
||||
int r2;
|
||||
|
||||
cig_check_nargs(1, nargs, "get_procmask");
|
||||
r1 = get_procmask(&r2);
|
||||
ret1 = ENTER_FIXNUM(r1);
|
||||
VECTOR_REF(*args,0) = ENTER_FIXNUM(r2);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
scheme_value df_set_int_handler(long nargs, scheme_value *args)
|
||||
{
|
||||
extern scheme_value set_int_handler(int , scheme_value , int , scheme_value *, int *);
|
||||
scheme_value ret1;
|
||||
scheme_value r1;
|
||||
scheme_value r2;
|
||||
int r3;
|
||||
|
||||
cig_check_nargs(4, nargs, "set_int_handler");
|
||||
r1 = set_int_handler(EXTRACT_FIXNUM(args[3]), args[2], EXTRACT_FIXNUM(args[1]), &r2, &r3);
|
||||
ret1 = r1;
|
||||
VECTOR_REF(*args,0) = r2;
|
||||
VECTOR_REF(*args,1) = ENTER_FIXNUM(r3);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
scheme_value df_get_int_handler(long nargs, scheme_value *args)
|
||||
{
|
||||
extern scheme_value get_int_handler(int , scheme_value *, int *);
|
||||
scheme_value ret1;
|
||||
scheme_value r1;
|
||||
scheme_value r2;
|
||||
int r3;
|
||||
|
||||
cig_check_nargs(2, nargs, "get_int_handler");
|
||||
r1 = get_int_handler(EXTRACT_FIXNUM(args[1]), &r2, &r3);
|
||||
ret1 = r1;
|
||||
VECTOR_REF(*args,0) = r2;
|
||||
VECTOR_REF(*args,1) = ENTER_FIXNUM(r3);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
|
@ -1,168 +0,0 @@
|
|||
;;; The signal-handling code in the last half of this file is obsolete. 8/23/96
|
||||
;;; Copyright (c) 1993 by Olin Shivers.
|
||||
;;; Job control code.
|
||||
|
||||
(foreign-source
|
||||
"#include <sys/signal.h>"
|
||||
"#include <sys/types.h>"
|
||||
"#include <unistd.h>"
|
||||
""
|
||||
"extern int errno;"
|
||||
""
|
||||
"#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)"
|
||||
"" "")
|
||||
|
||||
;;; Fork off a process that runs in its own process group. The process is
|
||||
;;; placed in its own process group before the process's actual work code is
|
||||
;;; executed. We block ^Z's until we've got the child into its own proc group.
|
||||
|
||||
(define (fork-job . maybe-thunk)
|
||||
(flush-all-ports)
|
||||
((with-blocked-interrupts (bitwise-ior (blocked-interrupts) ; Block ^Z.
|
||||
(interrupt-set signal/tstp))
|
||||
(cond ((%fork) => (lambda (child) (lambda () child))) ; Parent
|
||||
|
||||
(else ; Child
|
||||
(set-process-group (pid)) ; Put ourselves in our own proc group.
|
||||
(if (not (interrupt-handler signal/tstp)) ; If ignoring TSTP,
|
||||
(set-interrupt-handler signal/tstp #t)) ; reset to default.
|
||||
(set-batch-mode?! #t) ; Batch mode.
|
||||
(lambda () (and (pair? maybe-thunk) ; Release ^Z & do it.
|
||||
(call-terminally (car maybe-thunk)))))))))
|
||||
|
||||
|
||||
;;; Foreground a suspended or running background job.
|
||||
|
||||
(define (foreground-job proc-group)
|
||||
(let ((iport (current-input-port)))
|
||||
(cond ((and (not (batch-mode?)) (is-control-tty? iport))
|
||||
(dynamic-wind
|
||||
(lambda () (set-tty-process-group iport proc-group))
|
||||
(lambda ()
|
||||
(signal-process-group proc-group signal/cont) ; You go;
|
||||
(wait proc-group wait/stopped-children)) ; I'll wait.
|
||||
(lambda ()
|
||||
(with-blocked-interrupts
|
||||
(bitwise-ior (blocked-interrupts)
|
||||
(interrupt-set signal/ttou))
|
||||
(set-tty-process-group iport (process-group))))))
|
||||
|
||||
;; Oops, not really doing job control -- just wait on the process.
|
||||
(else (signal-process proc-group signal/cont) ; You go;
|
||||
(wait proc-group wait/stopped-children))))) ; I'll wait.
|
||||
|
||||
;;; Background a suspended job.
|
||||
|
||||
(define (background-job proc-group)
|
||||
(signal-process-group proc-group signal/cont))
|
||||
|
||||
|
||||
(define-simple-syntax (run . epf)
|
||||
(foreground-job (& . epf)))
|
||||
|
||||
(define-simple-syntax (& . epf)
|
||||
(fork-job (lambda () (exec-epf . epf))))
|
||||
|
||||
|
||||
;;; Need repl loop that manages some kind of a job table.
|
||||
;;; Interactive startup must ignore ^Z.
|
||||
|
||||
(define *control-tty-fdes* #f)
|
||||
(define (control-tty-fdes)
|
||||
(or *control-tty-fdes*
|
||||
(begin (set! *control-tty-fdes*
|
||||
(with-errno-handler ((errno data) (else #f))
|
||||
(open-fdes "/dev/tty" open/read)))
|
||||
*control-tty-fdes*)))
|
||||
|
||||
(define (is-control-tty? fd/port)
|
||||
(with-errno-handler ((errno data) (else #f)) ; False if you fail.
|
||||
(tty-process-group fd/port))) ; Try it.
|
||||
|
||||
|
||||
;;; Blocking interrupts
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (interrupt-set . interrupts)
|
||||
(let lp ((ints interrupts) (ans 0))
|
||||
(if (pair? ints)
|
||||
(lp (cdr ints) (bitwise-ior ans (arithmetic-shift 1 (- (car ints) 1))))
|
||||
ans)))
|
||||
|
||||
(define-simple-syntax (with-blocked-interrupts mask body ...)
|
||||
(with-blocked-interrupts* mask (lambda () body ...)))
|
||||
|
||||
(define (with-blocked-interrupts* mask thunk)
|
||||
(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 interrupt handlers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; I'm punting the MASK value for now.
|
||||
;;; I'm also punting returning real Scheme handlers for now.
|
||||
|
||||
(define (set-interrupt-handler interrupt handler)
|
||||
(receive (handler flags) ; Should be (handler mask flags).
|
||||
(%set-interrupt-handler interrupt handler 0)
|
||||
handler))
|
||||
|
||||
(define (interrupt-handler interrupt)
|
||||
(receive (handler flags) (%interrupt-handler interrupt)
|
||||
handler))
|
||||
|
||||
(define (%interrupt-handler interrupt)
|
||||
(receive (err handler flags) (%%interrupt-handler interrupt)
|
||||
(if err (errno-error err interrupt-handler interrupt)
|
||||
(process-interrupt-handler-retvals handler flags))))
|
||||
|
||||
;;; (%set-interrupt-handler interrupt handler [mask flags]) -> [handler mask flags]
|
||||
;;; Except no MASK for now.
|
||||
|
||||
(define (%set-interrupt-handler interrupt handler . args)
|
||||
(let-optionals args ((flags 0))
|
||||
(receive (err handler flags)
|
||||
(%%set-interrupt-handler interrupt handler flags)
|
||||
(if err
|
||||
(errno-error err %set-interrupt-handler interrupt handler flags)
|
||||
(process-interrupt-handler-retvals handler flags)))))
|
||||
|
||||
(define-foreign %%set-interrupt-handler (set_int_handler (fixnum signal)
|
||||
(desc handler)
|
||||
(fixnum flags))
|
||||
desc ; #f or errno
|
||||
desc ; handler
|
||||
fixnum) ; flags
|
||||
|
||||
(define-foreign %%interrupt-handler (get_int_handler (fixnum signal))
|
||||
desc ; #f or errno
|
||||
desc ; handler
|
||||
fixnum) ; flags
|
||||
|
||||
(define (process-interrupt-handler-retvals handler flags)
|
||||
(values (if (integer? handler)
|
||||
(error "We don't do Scheme handlers yet.")
|
||||
handler)
|
||||
flags))
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
/* Convert between a lo24/hi integer-pair bitset and a sigset_t value.
|
||||
** These macros are OS-dependent, and must be defined per-OS.
|
||||
*/
|
||||
|
||||
#define make_sigset(maskp, hi, lo) \
|
||||
((maskp)->__val[0] = (unsigned long int) ((hi) << 24) | (lo))
|
||||
|
||||
#define split_sigset(mask, hip, lop)\
|
||||
((*(hip) = ((mask).__val[0] >> 24) & 0xff),\
|
||||
(*(lop) = ((mask).__val[0] & 0xffffff)))
|
||||
|
|
@ -29,37 +29,6 @@ int sig2interrupt(int signal)
|
|||
}
|
||||
|
||||
|
||||
/* Hack the blocked-signal mask.
|
||||
*******************************************************************************
|
||||
*/
|
||||
|
||||
|
||||
#include "machine/sigset.h"
|
||||
|
||||
int set_procmask(int hi, int lo, int *old_lo_p)
|
||||
{
|
||||
sigset_t mask, old_mask;
|
||||
int old_hi;
|
||||
|
||||
make_sigset(&mask, hi, lo);
|
||||
|
||||
sigprocmask(SIG_SETMASK, &mask, &old_mask);
|
||||
split_sigset(old_mask, &old_hi, old_lo_p);
|
||||
return old_hi;
|
||||
}
|
||||
|
||||
|
||||
int get_procmask(int *old_lo_p)
|
||||
{
|
||||
sigset_t old_mask;
|
||||
int old_hi;
|
||||
|
||||
sigprocmask(SIG_SETMASK, NULL, &old_mask);
|
||||
split_sigset(old_mask, &old_hi, old_lo_p);
|
||||
return old_hi;
|
||||
}
|
||||
|
||||
|
||||
/* Set/Get signal handlers
|
||||
*******************************************************************************
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -1,10 +0,0 @@
|
|||
/* Convert between a lo24/hi integer-pair bitset and a sigset_t value.
|
||||
** These macros are OS-dependent, and must be defined per-OS.
|
||||
*/
|
||||
|
||||
#define make_sigset(maskp, hi, lo) ((maskp)->__sigbits[0]=((hi)<<24)|(lo))
|
||||
|
||||
/* Not a procedure: */
|
||||
#define split_sigset(mask, hip, lop) \
|
||||
((*(hip)=((mask).__sigbits[0]>>24)&0xff), \
|
||||
(*(lop)=((mask).__sigbits[0]&0xffffff)))
|
||||
Loading…
Reference in New Issue