From 6c136b907d72ac9ec37d303d20dd9b8f233318a5 Mon Sep 17 00:00:00 2001 From: mainzelm Date: Mon, 18 Dec 2000 15:45:46 +0000 Subject: [PATCH] removed obsolete files/code for jcontrol and signal sets --- scsh/aix/sigset.h | 10 --- scsh/bsd/sigset.h | 19 ----- scsh/jcontrol.scm | 64 ---------------- scsh/jcontrol1.c | 97 ------------------------ scsh/jcontrol2.c | 76 ------------------- scsh/jcontrol2.scm | 168 ------------------------------------------ scsh/linux/sigset.h | 10 --- scsh/sighandlers1.c | 31 -------- scsh/solaris/sigset.h | 10 --- 9 files changed, 485 deletions(-) delete mode 100644 scsh/aix/sigset.h delete mode 100644 scsh/bsd/sigset.h delete mode 100644 scsh/jcontrol.scm delete mode 100644 scsh/jcontrol1.c delete mode 100644 scsh/jcontrol2.c delete mode 100644 scsh/jcontrol2.scm delete mode 100644 scsh/linux/sigset.h delete mode 100644 scsh/solaris/sigset.h diff --git a/scsh/aix/sigset.h b/scsh/aix/sigset.h deleted file mode 100644 index ca6e50f..0000000 --- a/scsh/aix/sigset.h +++ /dev/null @@ -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))) diff --git a/scsh/bsd/sigset.h b/scsh/bsd/sigset.h deleted file mode 100644 index 3c62453..0000000 --- a/scsh/bsd/sigset.h +++ /dev/null @@ -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 -#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 diff --git a/scsh/jcontrol.scm b/scsh/jcontrol.scm deleted file mode 100644 index 2abd757..0000000 --- a/scsh/jcontrol.scm +++ /dev/null @@ -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. - diff --git a/scsh/jcontrol1.c b/scsh/jcontrol1.c deleted file mode 100644 index 3ee85e6..0000000 --- a/scsh/jcontrol1.c +++ /dev/null @@ -1,97 +0,0 @@ -/* This code is all obsolete & should be thrown away. 8/23/96 Olin. */ - -#include -#include -#include -#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< -#include /* For malloc. */ -#include "libcig.h" - -#include -#include -#include - -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; - } - diff --git a/scsh/jcontrol2.scm b/scsh/jcontrol2.scm deleted file mode 100644 index 42d7aab..0000000 --- a/scsh/jcontrol2.scm +++ /dev/null @@ -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 " - "#include " - "#include " - "" - "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)) diff --git a/scsh/linux/sigset.h b/scsh/linux/sigset.h deleted file mode 100644 index 7f04c5b..0000000 --- a/scsh/linux/sigset.h +++ /dev/null @@ -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))) diff --git a/scsh/sighandlers1.c b/scsh/sighandlers1.c index a8b7b91..7837c0a 100644 --- a/scsh/sighandlers1.c +++ b/scsh/sighandlers1.c @@ -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 ******************************************************************************* */ diff --git a/scsh/solaris/sigset.h b/scsh/solaris/sigset.h deleted file mode 100644 index 429f675..0000000 --- a/scsh/solaris/sigset.h +++ /dev/null @@ -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)))