From f4c06c96e744a4f6372cbb10dd401252e2f6d29d Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Thu, 18 Oct 2001 08:51:32 +0000
Subject: [PATCH] Let wait-pid use s48_raise_os_error and adapt Scheme code
 accordingly.

---
 scsh/procobj.scm  | 54 +++++++++++++++++++++--------------------------
 scsh/syscalls.scm |  2 +-
 scsh/syscalls1.c  |  9 ++++----
 3 files changed, 30 insertions(+), 35 deletions(-)

diff --git a/scsh/procobj.scm b/scsh/procobj.scm
index 95943b3..aa12d19 100644
--- a/scsh/procobj.scm
+++ b/scsh/procobj.scm
@@ -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
diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm
index 8f8a4e6..0c062bb 100644
--- a/scsh/syscalls.scm
+++ b/scsh/syscalls.scm
@@ -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
diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c
index 1b882a6..a52bb84 100644
--- a/scsh/syscalls1.c
+++ b/scsh/syscalls1.c
@@ -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));
 }