[Scsh-checkins] CVS: scsh-0.6/scsh procobj.scm,1.12,1.13 syscalls.scm,1.30,1.31 syscalls1.c,1.22,1.23

[Martin Gasbichler <mainzelm@users.sourceforge.net>]

Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv22612

Modified Files:
        procobj.scm syscalls.scm syscalls1.c 
Log Message:
Let wait-pid use s48_raise_os_error and adapt Scheme code accordingly.


Index: procobj.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/procobj.scm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -r1.12 -r1.13
*** procobj.scm 2001/10/03 14:41:01     1.12
--- procobj.scm 2001/10/18 08:51:32     1.13
***************
*** 308,320 ****
    (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)))))
    
  
--- 308,317 ----
    (if (< pid 1)
        (error "really-wait on nonpos pid" pid))
!   (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)))))
    
  
***************
*** 423,450 ****
  ;;; [#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))))))
  
  (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))))))
  
  
--- 420,444 ----
  ;;; [#f #t] means no waitable process on wait-any.
  
  (define (%wait-any flags)
!   (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)
!   (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)))))
  
  

Index: syscalls.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls.scm,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -r1.30 -r1.31
*** syscalls.scm        2001/10/09 19:47:00     1.30
--- syscalls.scm        2001/10/18 08:51:32     1.31
***************
*** 88,92 ****
  (import-os-error-syscall %wait-pid/list (pid options) "wait_pid")
  
! (define (%wait-pid/errno pid options)
    (apply values (%wait-pid/list pid options)))
  
--- 88,92 ----
  (import-os-error-syscall %wait-pid/list (pid options) "wait_pid")
  
! (define (%wait-pid pid options)
    (apply values (%wait-pid/list pid options)))
  

Index: syscalls1.c
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls1.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -r1.22 -r1.23
*** syscalls1.c 2001/10/03 14:44:45     1.22
--- syscalls1.c 2001/10/18 08:51:32     1.23
***************
*** 64,71 ****
  
    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)));
  }
  
--- 64,72 ----
  
    result_pid = waitpid(pid, &status, flags);
!   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));
  }