scsh-0.6/scsh/jcontrol.scm

65 lines
2.0 KiB
Scheme

;;; 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.