;;; Copyright (c) 1993 by Olin Shivers.
;;; Job control code. See file COPYING.

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