scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Let wait-pid use s48_raise_os_error and adapt Scheme code accordingly.

This commit is contained in:
mainzelm 2001-10-18 08:51:32 +00:00
parent 15e8266fc2
commit f4c06c96e7
3 changed files with 30 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
scsh/procobj.scm
View File

@ -307,15 +307,12 @@
(error "really-wait without wait/poll"))
(if (< pid 1)
(error "really-wait on nonpos pid" pid))
(receive (err return_pid status) (%wait-pid/errno pid flags)
(cond ((not err)
(cond ((zero? return_pid) #f) ; failed wait/poll
((= pid return_pid) status) ; made it
(else (error "mismatch in really-wait"
return_pid pid))))
((= err errno/intr)
(really-wait pid flags))
(else (errno-error err %wait-pid pid flags)))))
(receive (return_pid status)
(%wait-pid pid flags)
(cond ((zero? return_pid) #f) ; failed wait/poll
((= pid return_pid) status) ; made it
(else (error "mismatch in really-wait"
return_pid pid)))))
@ -422,30 +419,27 @@
;;; [#f #f] means no processes ready on a non-blocking wait.
;;; [#f #t] means no waitable process on wait-any.
(define (%wait-pid pid flags)
(let lp ()
(receive (err pid status) (%wait-pid/errno pid flags)
(cond ((not err) (and (not (zero? pid)) status)) ; pid=0 => none ready.
((= err errno/intr) (lp))
(else (errno-error err %wait-pid pid flags))))))
(define (%wait-any flags)
(let lp ()
(receive (err pid status) (%wait-pid/errno -1 flags)
(cond (err (cond ((= err errno/child) (values #f #t)) ; No more.
((= err errno/intr) (lp))
(else (errno-error err %wait-any flags))))
((zero? pid) (values #f #f)) ; None ready.
(else (values pid status))))))
(with-errno-handler
((errno packet)
((errno/child)
(values #f #t)))
(receive (pid status)
(%wait-pid -1 flags)
(if (zero? pid)
(values #f #f) ; None ready.
(values pid status)))))
(define (%wait-process-group pgrp flags)
(let lp ()
(receive (err pid status) (%wait-pid/errno (- pgrp) flags)
(cond (err (cond ((= err errno/child) (values #f #t)) ; No more.
((= err errno/intr) (lp))
(else (errno-error err %wait-process-group pgrp flags))))
((zero? pid) (values #f #f)) ; None ready.
(else (values pid status))))))
(with-errno-handler
((errno packet)
((errno/child)
(values #f #t)))
(receive (pid status)
(%wait-pid (- pgrp) flags)
(if (zero? pid)
(values #f #f) ; None ready.
(values pid status)))))
;;; Reaped process table

2
scsh/syscalls.scm
View File

@ -87,7 +87,7 @@
;;; Posix waitpid(2) call.
(import-os-error-syscall %wait-pid/list (pid options) "wait_pid")
(define (%wait-pid/errno pid options)
(define (%wait-pid pid options)
(apply values (%wait-pid/list pid options)))
;;; Miscellaneous process state

9
scsh/syscalls1.c
View File

@ -63,10 +63,11 @@ s48_value wait_pid(s48_value s48_pid, s48_value s48_flags)
pid_t result_pid;
result_pid = waitpid(pid, &status, flags);
return s48_cons ((result_pid == -1) ? s48_enter_fixnum(errno) : S48_FALSE,
s48_cons (s48_enter_integer (result_pid),
s48_cons (s48_enter_integer (status),
S48_NULL)));
if (result_pid == -1)
s48_raise_os_error_2 (errno, s48_pid, s48_flags);
return s48_cons (s48_enter_integer (result_pid),
s48_cons (s48_enter_integer (status),
S48_NULL));
}