There was an atomicity problem/race condition -- if a child process died

after it was forked, but before the scsh fork procedure could register
the child's procobj in the pid/procobj table, then when the SIGCHLD
signal-handler reaped the process, there would be no procobj for it.
We now lock out interrupts across the fork and register operations.
This commit is contained in:
shivers 1997-04-30 20:33:26 +00:00
parent 0f1f30eaa1
commit 4703ce142a
2 changed files with 16 additions and 9 deletions

View File

@ -314,7 +314,7 @@
reaped-procs)) reaped-procs))
(lambda () #f))) (lambda () #f)))
(else (lambda () ; Do this w/interrupts enabled. (else (lambda () ; Do this w/interrupts enabled.
(error "Child pid mysteriously missing proc object." pid))))))) (warn "Exiting child pid has no proc object." pid status)))))))
;;; Pop one off the list. ;;; Pop one off the list.
(define (get-reaped-proc!) (define (get-reaped-proc!)

View File

@ -702,14 +702,21 @@
(really-fork #f maybe-thunk)) (really-fork #f maybe-thunk))
(define (really-fork clear-interactive? maybe-thunk) (define (really-fork clear-interactive? maybe-thunk)
((with-enabled-interrupts 0
(let ((pid (%%fork))) (let ((pid (%%fork)))
(cond ((zero? pid) ; Child (if (zero? pid)
;; Child
(lambda () ; Do all this outside the WITH-INTERRUPTS.
(set! reaped-procs '()) (set! reaped-procs '())
(if clear-interactive? (if clear-interactive?
(set-batch-mode?! #t)) ; Children are non-interactive. (set-batch-mode?! #t)) ; Children are non-interactive.
(and (pair? maybe-thunk) (and (pair? maybe-thunk)
(call-terminally (car maybe-thunk)))) (call-terminally (car maybe-thunk))))
(else (new-child-proc pid))))) ; Parent
;; Parent
(let ((proc (new-child-proc pid)))
(lambda () proc)))))))
(define (exit . maybe-status) (define (exit . maybe-status)