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
-  errno
-  msg
-  stuff)
+;;; 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 ()
@@ -27,28 +39,27 @@
        (import-lambda-definition syscall/eintr (%arg ...) c-name)
        (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))))))))
+	   (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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;