Use continuation-graft in import-os-error-syscall.

scsh/syscalls.scm

@@ -15,10 +15,22 @@
 ;;; You can't throw an error within a handler
 ;;;
 
-(define-record err
+;;; Move this to somewhere else as soon as Marc published his SRFI
-  errno
+(define (continuation-capture receiver)
-  msg
+  (call-with-current-continuation
-  stuff)
+   (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 ()
@@ -27,28 +39,27 @@
        (import-lambda-definition syscall/eintr (%arg ...) c-name)
        (define (syscall %arg ...)
 	 (let ((arg %arg) ...)
-	   (let ((res
+	   (continuation-capture 
-		  (call-with-current-continuation
+	    (lambda (cont)
-		   (lambda (k)
+	      (let loop ()
-		     (let loop ()
+		(with-handler
-		       (with-handler
+		 (lambda (condition more)
-			(lambda (condition more)
+		   (if (and (exception? condition) (eq? (exception-reason condition) 
-			  (if (and (exception? condition) (eq? (exception-reason condition) 
+							'os-error))
-							       'os-error))
+		       (let ((stuff (exception-arguments condition)))
-			      (let ((stuff (exception-arguments condition)))
+			 (if (= (cadr stuff) errno/intr)
-				(if (= (cadr stuff) errno/intr)
+			     (loop)
-				    (loop)
+			     (continuation-graft
-				    (k (make-err (cadr stuff)   ; errno
+			      cont
-						 (caddr stuff)  ;msg
+			      (lambda ()
-						 (cdddr stuff) ;packet
+				(apply errno-error 
-						 )))) ; (msg syscall . packet)
+				       (cadr stuff)   ; errno
-			      (more)))
+				       (caddr stuff)  ;msg
-			(lambda ()
+				       syscall 
-			  (syscall/eintr %arg ...)))))))) ;BOGUS
+				       (cdddr stuff)))))) ;packet
-	     (if (err? res)
+		       (more)))
-		 (apply errno-error (err:errno res) (err:msg res) syscall 
+		 (lambda ()
-			(err:stuff res))
+		   (syscall/eintr %arg ...))))))))))))
-		 res))))))))
   
 ;;; Process
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;