[Scsh-checkins] CVS: scsh-0.6/scsh syscalls.scm,1.28,1.29

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

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

Modified Files:
        syscalls.scm 
Log Message:
Use continuation-graft in import-os-error-syscall.


Index: syscalls.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls.scm,v
retrieving revision 1.28
retrieving revision 1.29
diff -C2 -r1.28 -r1.29
*** syscalls.scm        2001/09/12 14:08:24     1.28
--- syscalls.scm        2001/09/17 15:30:12     1.29
***************
*** 16,24 ****
  ;;;
  
! (define-record err
!   errno
!   msg
!   stuff)
  
  (define-syntax import-os-error-syscall
    (syntax-rules ()
--- 16,36 ----
  ;;;
  
! ;;; Move this to somewhere else as soon as Marc published his SRFI
! (define (continuation-capture receiver)
!   (call-with-current-continuation
!    (lambda (k)
!      (receiver (lambda (thunk)
!                (call-with-values 
!                 thunk
!                 k))))))
  
+ (define (continuation-graft cont thunk)
+   (cont thunk))
+ 
+ (define (continuation-return cont . returned-values)
+   (continuation-graft
+    cont
+    (lambda () (apply values returned-values))))
+ 
  (define-syntax import-os-error-syscall
    (syntax-rules ()
***************
*** 28,53 ****
         (define (syscall %arg ...)
         (let ((arg %arg) ...)
!          (let ((res
!                 (call-with-current-continuation
!                  (lambda (k)
!                    (let loop ()
!                      (with-handler
!                       (lambda (condition more)
!                         (if (and (exception? condition) (eq? 
(exception-reason condition) 
!                                                              'os-error))
!                             (let ((stuff (exception-arguments condition)))
!                               (if (= (cadr stuff) errno/intr)
!                                   (loop)
!                                   (k (make-err (cadr stuff)   ; errno
!                                                (caddr stuff)  ;msg
!                                                (cdddr stuff) ;packet
!                                                )))) ; (msg syscall . packet)
!                             (more)))
!                       (lambda ()
!                         (syscall/eintr %arg ...)))))))) ;BOGUS
!            (if (err? res)
!                (apply errno-error (err:errno res) (err:msg res) syscall 
!                       (err:stuff res))
!                res))))))))
    
  ;;; Process
--- 40,64 ----
         (define (syscall %arg ...)
         (let ((arg %arg) ...)
!          (continuation-capture 
!           (lambda (cont)
!             (let loop ()
!               (with-handler
!                (lambda (condition more)
!                  (if (and (exception? condition) (eq? (exception-reason 
condition) 
!                                                       'os-error))
!                      (let ((stuff (exception-arguments condition)))
!                        (if (= (cadr stuff) errno/intr)
!                            (loop)
!                            (continuation-graft
!                             cont
!                             (lambda ()
!                               (apply errno-error 
!                                      (cadr stuff)   ; errno
!                                      (caddr stuff)  ;msg
!                                      syscall 
!                                      (cdddr stuff)))))) ;packet
!                      (more)))
!                (lambda ()
!                  (syscall/eintr %arg ...))))))))))))
    
  ;;; Process