From 4703ce142ad24180a22979af79634181879109b3 Mon Sep 17 00:00:00 2001 From: shivers Date: Wed, 30 Apr 1997 20:33:26 +0000 Subject: [PATCH] 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. --- scsh/procobj.scm | 2 +- scsh/scsh.scm | 23 +++++++++++++++-------- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/scsh/procobj.scm b/scsh/procobj.scm index 1aaa130..5849ab1 100644 --- a/scsh/procobj.scm +++ b/scsh/procobj.scm @@ -314,7 +314,7 @@ reaped-procs)) (lambda () #f))) (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. (define (get-reaped-proc!) diff --git a/scsh/scsh.scm b/scsh/scsh.scm index d92257f..05e5045 100644 --- a/scsh/scsh.scm +++ b/scsh/scsh.scm @@ -702,14 +702,21 @@ (really-fork #f maybe-thunk)) (define (really-fork clear-interactive? maybe-thunk) - (let ((pid (%%fork))) - (cond ((zero? pid) ; Child - (set! reaped-procs '()) - (if clear-interactive? - (set-batch-mode?! #t)) ; Children are non-interactive. - (and (pair? maybe-thunk) - (call-terminally (car maybe-thunk)))) - (else (new-child-proc pid))))) ; Parent + ((with-enabled-interrupts 0 + (let ((pid (%%fork))) + (if (zero? pid) + + ;; Child + (lambda () ; Do all this outside the WITH-INTERRUPTS. + (set! reaped-procs '()) + (if clear-interactive? + (set-batch-mode?! #t)) ; Children are non-interactive. + (and (pair? maybe-thunk) + (call-terminally (car maybe-thunk)))) + + ;; Parent + (let ((proc (new-child-proc pid))) + (lambda () proc))))))) (define (exit . maybe-status)