From 59c2584a1eda94c19fbef07bb8bfa36da3c0ce1c Mon Sep 17 00:00:00 2001 From: Nala Ginrut Date: Mon, 13 May 2019 18:45:54 +0800 Subject: [PATCH] Add current-suspendable-io-status When suspendable-port is blocking, the IO waiter function can get the status of the current IO operation. (current-suspendable-io-status) returns a pair: (finished-bytes . rest-bytes) --- module/ice-9/suspendable-ports.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm index a366c8b9c..33d307a2c 100644 --- a/module/ice-9/suspendable-ports.scm +++ b/module/ice-9/suspendable-ports.scm @@ -54,6 +54,7 @@ #:use-module (ice-9 match) #:export (current-read-waiter current-write-waiter + current-suspendable-io-status install-suspendable-ports! uninstall-suspendable-ports!)) @@ -63,6 +64,7 @@ (define current-read-waiter (make-parameter default-read-waiter)) (define current-write-waiter (make-parameter default-write-waiter)) +(define current-suspendable-io-status (make-parameter (cons 0 0))) (define (wait-for-readable port) ((current-read-waiter) port)) (define (wait-for-writable port) ((current-write-waiter) port)) @@ -75,7 +77,8 @@ (error "bad return from port read function" read)) read)) (else - (wait-for-readable port) + (parameterize ((current-suspendable-io-status (cons start count))) + (wait-for-readable port)) (read-bytes port dst start count)))) (define (write-bytes port src start count) @@ -87,7 +90,8 @@ (when (< written count) (write-bytes port src (+ start written) (- count written))))) (else - (wait-for-writable port) + (parameterize ((current-suspendable-io-status (cons start count))) + (wait-for-writable port)) (write-bytes port src start count)))) (define (flush-input port) -- 2.20.1