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

2
scsh/syscalls.scm
View File

@ -87,7 +87,7 @@
;;; Posix waitpid(2) call. ;;; Posix waitpid(2) call.
(import-os-error-syscall %wait-pid/list (pid options) "wait_pid") (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))) (apply values (%wait-pid/list pid options)))
;;; Miscellaneous process state ;;; 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; pid_t result_pid;
result_pid = waitpid(pid, &status, flags); result_pid = waitpid(pid, &status, flags);
return s48_cons ((result_pid == -1) ? s48_enter_fixnum(errno) : S48_FALSE, if (result_pid == -1)
s48_cons (s48_enter_integer (result_pid), s48_raise_os_error_2 (errno, s48_pid, s48_flags);
s48_cons (s48_enter_integer (status), return s48_cons (s48_enter_integer (result_pid),
S48_NULL))); s48_cons (s48_enter_integer (status),
S48_NULL));
} }