Unexpectedly low read/write performance of open-pipe

Unexpectedly low read/write performance of open-pipe

[Rob Browning]

While evaluating guile as a possibility to replace some python code,
assuming I'm not just doing something wrong, I noticed that open-pipe
appears to transfer data *much* more slowly than python when OPEN_BOTH is
specified as opposed to OPEN_READ:

  discarding dev-zero as file: 12500.00 mb/s
  discarding dev-zero via OPEN_READ: 4132.23 mb/s
  discarding dev-zero via OPEN_WRITE: 1.42 mb/s

For something similar to the original python code and roughly similar to
open-pipe OPEN_BOTH (see code below) I see:

  mb/s: 1713.26754296

In the end, what I'd need is an OPEN_BOTH (or equivalent) that could
support block-reads and ideally read-delimited operations
on the subproces output pipe at speeds much closer to python's.


Here's the trivial guile test program:

#!/usr/bin/env guile -s
!#

(use-modules
 ((ice-9 binary-ports) :select (get-bytevector-n! put-bytevector))
 ((ice-9 format) :select (format))
 ((ice-9 popen) :select (open-pipe open-pipe*))
 ((rnrs bytevectors) :select (bytevector-length make-bytevector)))

(define (cat-bytes src dest len)
  ;; Discard bytes if dest is #f
  (let* ((buf (make-bytevector 65536))
         (buf-len (bytevector-length buf)))
    (let loop ((remaining len))
      (unless (zero? remaining)
        (let ((n-or-eof (get-bytevector-n! src buf 0 (min remaining buf-len))))
          (unless (eof-object? n-or-eof)
            (when dest (put-bytevector dest buf 0 n-or-eof))
            (loop (- remaining n-or-eof))))))))

(define *discard* #f)

(define *dev-zero* (with-fluids ((%default-port-encoding #f))
                     (open-input-file "/dev/zero")))

(define (cat-zero mode)
  (with-fluids ((%default-port-encoding #f))
    (open-pipe* mode "cat" "/dev/zero")))

(define (time-cat-mb mb src dest)
  (let ((start (tms:clock (times))))
    (cat-bytes src dest (* mb 1024 1024))
    (when dest (force-output dest))
    (let ((end (tms:clock (times))))
      (format (current-error-port)
              "~,2f mb/s\n" (/ mb
                               (/ (- (tms:clock (times)) start)
                                  internal-time-units-per-second))))))

(display "discarding dev-zero as file: " (current-error-port))
(time-cat-mb 10000 *dev-zero* *discard*)
(display "discarding dev-zero via OPEN_READ: " (current-error-port))
(time-cat-mb 5000 (cat-zero OPEN_READ) *discard*)
(display "discarding dev-zero via OPEN_WRITE: " (current-error-port))
(time-cat-mb 10 (cat-zero OPEN_BOTH) *discard*)

And here's the python code:

#!/usr/bin/env python

import os, subprocess

proc = subprocess.Popen(['cat', '/dev/zero'],
                        stdin=subprocess.PIPE, stdout=subprocess.PIPE,
                        close_fds = True, bufsize = 4096)

n_kb = 1000000
start = os.times()[4]
written = 0
for i in range(n_kb):
    assert(len(proc.stdout.read(1024)) == 1024)
    written += 1024
end = os.times()[4]

proc.terminate()
proc.wait()

print "mb/s:", (n_kb / 1024.0) / (end - start)

Thanks
-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

Re: Unexpectedly low read/write performance of open-pipe

[Rob Browning]

Rob Browning <rlb@defaultvalue.org> writes:

> While evaluating guile as a possibility to replace some python code,
> assuming I'm not just doing something wrong, I noticed that open-pipe
> appears to transfer data *much* more slowly than python when OPEN_BOTH is
> specified as opposed to OPEN_READ

Oh, and I should have mentioned the version:

  guile (GNU Guile) 2.2.4
  Packaged by Debian (2.2.4-deb+1-1)

For what it's worth, in an earlier round of testing I also hacked up
open-pipe to let me access the underlying ports and set their buffers to
65k.  That doubled the transfer rate, but of course, it's still fairly
slow.

Thanks
-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

Re: Unexpectedly low read/write performance of open-pipe

[Rob Browning]

Rob Browning <rlb@defaultvalue.org> writes:

> For what it's worth, in an earlier round of testing I also hacked up
> open-pipe to let me access the underlying ports and set their buffers to
> 65k.  That doubled the transfer rate, but of course, it's still fairly
> slow.

I also ran statprof on the OPEN_BOTH case and saw that the majority of
the time was spent in read-char (guessing via the open-pipe soft-port).
I also observed that the machine's fan spun up during the OPEN_BOTH test
(presumably due to high CPU use).

I haven't tried to track it down yet, but if the only underlying way to
get a fixed block of data out of an OPEN_BOTH port is read-char, then
that might explain much of the difference.

-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

Re: Unexpectedly low read/write performance of open-pipe

[Rob Browning]

Rob Browning <rlb@defaultvalue.org> writes:

> I haven't tried to track it down yet, but if the only underlying way to
> get a fixed block of data out of an OPEN_BOTH port is read-char, then
> that might explain much of the difference.

And this, in popen.scm was why I started wondering about that:

  (call-with-values (lambda ()
                      (apply open-process mode command args))
    (lambda (read-port write-port pid)
      (let ((port (or (and read-port write-port
                           (make-rw-port read-port write-port))
                      read-port
                      write-port
                      (%make-void-port mode)))
            (pipe-info (make-pipe-info pid)))

I *think* OPEN_BOTH triggers make-rw-port here, which creates a
soft-port.

I'd guess that what I might really want instead is for it to be able to
create a native, bidirectional binary-port (using the two pipes
internally).

Thanks
-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

Re: Unexpectedly low read/write performance of open-pipe

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 1695 bytes --]

Hi Rob,

Rob Browning <rlb@defaultvalue.org> writes:

> Rob Browning <rlb@defaultvalue.org> writes:
>
>> I haven't tried to track it down yet, but if the only underlying way to
>> get a fixed block of data out of an OPEN_BOTH port is read-char, then
>> that might explain much of the difference.
>
> And this, in popen.scm was why I started wondering about that:
>
>   (call-with-values (lambda ()
>                       (apply open-process mode command args))
>     (lambda (read-port write-port pid)
>       (let ((port (or (and read-port write-port
>                            (make-rw-port read-port write-port))
>                       read-port
>                       write-port
>                       (%make-void-port mode)))
>             (pipe-info (make-pipe-info pid)))
>
> I *think* OPEN_BOTH triggers make-rw-port here, which creates a
> soft-port.

Exactly.  It's a Guile legacy soft port which works one byte at a time.
Terrible.  I've known about this issue for years, but until recently
these legacy soft ports were the only kind of Scheme-level custom port
that supported read+write mode.

> I'd guess that what I might really want instead is for it to be able to
> create a native, bidirectional binary-port (using the two pipes
> internally).

Indeed.  The good news is that we now have R6RS custom binary
input/outputs ports, which use an efficient internal interface based on
bytevectors, and perform much better.

See below for a draft reimplementation of the OPEN_BOTH mode of
open-pipe* based on R6RS custom binary input/output.  On my machine it
increases the speed of your test by a factor of ~1k.

Let me know how it works for you.

      Regards,
        Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] DRAFT: open-pipe*: Improve performance of OPEN_BOTH mode --]
[-- Type: text/x-patch, Size: 3730 bytes --]

From 4612e23994a012ef97e345a927fe9d0f232e78ab Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Mon, 8 Apr 2019 06:23:08 -0400
Subject: [PATCH] DRAFT: open-pipe*: Improve performance of OPEN_BOTH mode.

* module/ice-9/popen.scm (make-rw-port): Re-implement using R6RS custom
binary input/output ports.
---
 module/ice-9/popen.scm | 59 ++++++++++++++++++++++++++++++++----------
 1 file changed, 46 insertions(+), 13 deletions(-)

diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm
index b166e9d0f..c8ce0e2e0 100644
--- a/module/ice-9/popen.scm
+++ b/module/ice-9/popen.scm
@@ -1,7 +1,7 @@
 ;; popen emulation, for non-stdio based ports.
 
 ;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2006, 2010, 2011, 2012,
-;;;;   2013 Free Software Foundation, Inc.
+;;;;   2013, 2019 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,10 +19,12 @@
 ;;;; 
 
 (define-module (ice-9 popen)
-  :use-module (ice-9 threads)
-  :use-module (srfi srfi-9)
-  :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
-	   open-output-pipe open-input-output-pipe))
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-9)
+  #:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
+            open-output-pipe open-input-output-pipe))
 
 (eval-when (expand load eval)
   (load-extension (string-append "libguile-" (effective-version))
@@ -34,14 +36,45 @@
   (pid pipe-info-pid set-pipe-info-pid!))
 
 (define (make-rw-port read-port write-port)
-  (make-soft-port
-   (vector
-    (lambda (c) (write-char c write-port))
-    (lambda (s) (display s write-port))
-    (lambda () (force-output write-port))
-    (lambda () (read-char read-port))
-    (lambda () (close-port read-port) (close-port write-port)))
-   "r+"))
+  (define buffer #vu8())
+  (define position 0)
+  (define (read! bv start count)
+    (if (< position (bytevector-length buffer))
+        (let* ((available (- (bytevector-length buffer) position))
+               (transfer-size (min count available)))
+          (when (zero? transfer-size)
+            (error "(ice-9 popen) rw-port read!: zero transfer-size, should not happen"))
+          (bytevector-copy! buffer position bv start transfer-size)
+          (if (= transfer-size available)
+              (begin (set! buffer #vu8())
+                     (set! position 0))
+              (set! position (+ position transfer-size)))
+          transfer-size)
+        (let ((read-result (get-bytevector-some read-port)))
+          (if (eof-object? read-result)
+              0  ; return 0 to indicate eof
+              (begin
+                (set! buffer read-result)
+                (set! position 0)
+                (read! bv start count))))))
+  (define (write! bv start count)
+    (put-bytevector write-port bv start count)
+    count)
+  (define (close)
+    (set! buffer #vu8())
+    (set! position 0)
+    (close-port read-port)
+    (close-port write-port))
+  (define rw-port
+    (make-custom-binary-input/output-port "ice-9-popen-rw-port"
+                                          read!
+                                          write!
+                                          #f ;get-position
+                                          #f ;set-position!
+                                          close))
+  (setvbuf read-port 'block 65536)
+  (set-port-encoding! rw-port (port-encoding read-port))
+  rw-port)
 
 ;; a guardian to ensure the cleanup is done correctly when
 ;; an open pipe is gc'd or a close-port is used.
-- 
2.21.0

Re: Unexpectedly low read/write performance of open-pipe

[Rob Browning]

Mark H Weaver <mhw@netris.org> writes:

> See below for a draft reimplementation of the OPEN_BOTH mode of
> open-pipe* based on R6RS custom binary input/output.  On my machine it
> increases the speed of your test by a factor of ~1k.

Hah, I was about to report that I'd tested something along similar lines
(though much more a quick hack to just replace make-rw-port and see what
happened), and that I had seen substantial improvements:

  (define (make-rw-bin-port read-port write-port)
    (define (read! dest offset count)
      (let ((result (get-bytevector-n! read-port dest offset count)))
        (if (eof-object? result) 0 result)))
    (define (write! src offset count)
      (put-bytevector write-port src offset count)
      count)
    (define (close x)
      (close-port read-port)
      (close-port write-port))
    (make-custom-binary-input/output-port "open-bin-pipe-port"
                                          read! write! #f #f
                                          close))

> Let me know how it works for you.

For a first quick test of your patch using the original program I was
working on, I see about ~1.4MiB/s without the patch, and about 150MiB/s
with it, measured by pv.

(If the patch holds up, it'd be nice to have in 2.2, but I suppose that
 might not be appropriate.)

Thanks
-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

Re: Unexpectedly low read/write performance of open-pipe

[Mark H Weaver]

Hi Rob,

Rob Browning <rlb@defaultvalue.org> writes:

> Mark H Weaver <mhw@netris.org> writes:
>
>> See below for a draft reimplementation of the OPEN_BOTH mode of
>> open-pipe* based on R6RS custom binary input/output.  On my machine it
>> increases the speed of your test by a factor of ~1k.
>
> Hah, I was about to report that I'd tested something along similar lines
> (though much more a quick hack to just replace make-rw-port and see what
> happened), and that I had seen substantial improvements:
>
>   (define (make-rw-bin-port read-port write-port)
>     (define (read! dest offset count)
>       (let ((result (get-bytevector-n! read-port dest offset count)))
>         (if (eof-object? result) 0 result)))
>     (define (write! src offset count)
>       (put-bytevector write-port src offset count)
>       count)
>     (define (close x)
>       (close-port read-port)
>       (close-port write-port))
>     (make-custom-binary-input/output-port "open-bin-pipe-port"
>                                           read! write! #f #f
>                                           close))

Hah, we had the same idea! :-)

FYI, the reason I didn't use 'get-bytevector-n!', although it leads to
the much simpler code above, is that it has the wrong semantics
w.r.t. blocking behavior.  'get-bytevector-n!' blocks until the entire
requested count is read, returning less than the requested amount only
if EOF is reached.

In this case, 'read!' is free to return less than 'count' bytes, and
should block _only_ as needed to ensure that at least one byte is
returned (or EOF).  Of course, an effort should be made to return
additional bytes, and preferably a sizeable buffer, but only if it can
be done without blocking unnecessarily.

Guile has only one I/O primitive capable of doing this job efficiently:
'get-bytevector-some'.  Internally, it works by simply returning the
entire existing port read buffer if it's non-empty.  If the read buffer
is empty, then read(2) is used to refill the read buffer, which is then
returned to the user.

The reason for the extra complexity in my reimplementation is that
there's no way to specify an upper bound on the size of the bytevector
returned by 'get-bytevector-some', so in general we may need to preserve
the remaining bytes more future 'read!' calls.

>> Let me know how it works for you.
>
> For a first quick test of your patch using the original program I was
> working on, I see about ~1.4MiB/s without the patch, and about 150MiB/s
> with it, measured by pv.

It's interesting that I saw a much larger improvement than you're
seeing.  In my case, the numbers reported by your test program went from
~0.35 mb/s to ~333 mb/s, on a Thinkpad X200.

> (If the patch holds up, it'd be nice to have in 2.2, but I suppose that
>  might not be appropriate.)

I think it's probably fine for 2.2, although a more careful check should
be made for differences in behavior between the old and new
implementations, and tests should be added.  I'll try to get to it soon.

      Regards,
        Mark

Re: Unexpectedly low read/write performance of open-pipe

[Chris Vine]

On Tue, 09 Apr 2019 04:35:38 -0400
Mark H Weaver <mhw@netris.org> wrote:
> Hi Rob,
> 
> Rob Browning <rlb@defaultvalue.org> writes:
> 
> > Mark H Weaver <mhw@netris.org> writes:
> >
> >> See below for a draft reimplementation of the OPEN_BOTH mode of
> >> open-pipe* based on R6RS custom binary input/output.  On my machine it
> >> increases the speed of your test by a factor of ~1k.
> >
> > Hah, I was about to report that I'd tested something along similar lines
> > (though much more a quick hack to just replace make-rw-port and see what
> > happened), and that I had seen substantial improvements:
> >
> >   (define (make-rw-bin-port read-port write-port)
> >     (define (read! dest offset count)
> >       (let ((result (get-bytevector-n! read-port dest offset count)))
> >         (if (eof-object? result) 0 result)))
> >     (define (write! src offset count)
> >       (put-bytevector write-port src offset count)
> >       count)
> >     (define (close x)
> >       (close-port read-port)
> >       (close-port write-port))
> >     (make-custom-binary-input/output-port "open-bin-pipe-port"
> >                                           read! write! #f #f
> >                                           close))
> 
> Hah, we had the same idea! :-)
> 
> FYI, the reason I didn't use 'get-bytevector-n!', although it leads to
> the much simpler code above, is that it has the wrong semantics
> w.r.t. blocking behavior.  'get-bytevector-n!' blocks until the entire
> requested count is read, returning less than the requested amount only
> if EOF is reached.
> 
> In this case, 'read!' is free to return less than 'count' bytes, and
> should block _only_ as needed to ensure that at least one byte is
> returned (or EOF).  Of course, an effort should be made to return
> additional bytes, and preferably a sizeable buffer, but only if it can
> be done without blocking unnecessarily.
> 
> Guile has only one I/O primitive capable of doing this job efficiently:
> 'get-bytevector-some'.  Internally, it works by simply returning the
> entire existing port read buffer if it's non-empty.  If the read buffer
> is empty, then read(2) is used to refill the read buffer, which is then
> returned to the user.
> 
> The reason for the extra complexity in my reimplementation is that
> there's no way to specify an upper bound on the size of the bytevector
> returned by 'get-bytevector-some', so in general we may need to preserve
> the remaining bytes more future 'read!' calls.
> 
> >> Let me know how it works for you.
> >
> > For a first quick test of your patch using the original program I was
> > working on, I see about ~1.4MiB/s without the patch, and about 150MiB/s
> > with it, measured by pv.
> 
> It's interesting that I saw a much larger improvement than you're
> seeing.  In my case, the numbers reported by your test program went from
> ~0.35 mb/s to ~333 mb/s, on a Thinkpad X200.
> 
> > (If the patch holds up, it'd be nice to have in 2.2, but I suppose that
> >  might not be appropriate.)
> 
> I think it's probably fine for 2.2, although a more careful check should
> be made for differences in behavior between the old and new
> implementations, and tests should be added.  I'll try to get to it soon.

If it is going in 2.2 (or 3.0) it would be nice if the ports could be
suspendable.  put-bytevector (used by write!) is suspendable;
get-bytevector-some (used by read!) is not.

Chris

Re: Unexpectedly low read/write performance of open-pipe

[Mark H Weaver]

Hi Chris,

Chris Vine <vine35792468@gmail.com> writes:

> On Tue, 09 Apr 2019 04:35:38 -0400
> Mark H Weaver <mhw@netris.org> wrote:
>> 
>> I think it's probably fine for 2.2, although a more careful check should
>> be made for differences in behavior between the old and new
>> implementations, and tests should be added.  I'll try to get to it soon.
>
> If it is going in 2.2 (or 3.0) it would be nice if the ports could be
> suspendable.  put-bytevector (used by write!) is suspendable;
> get-bytevector-some (used by read!) is not.

Unless I'm mistaken, nothing done within custom ports is suspendable,
regardless of which I/O primitives are used, because the custom port
implementations themselves are all written in C.  The custom port
handlers such as 'read!' and 'write!' are always invoked from C code.
Caleb Ristvedt recently ran into this problem and posted about it on
guile-user:

  https://lists.gnu.org/archive/html/guile-user/2019-03/msg00032.html

I responded here:

  https://lists.gnu.org/archive/html/guile-user/2019-04/msg00000.html

I'm not sure off-hand what would be required to re-implement custom
ports in suspendable Scheme code.  Andy Wingo would be a good person to
ask, since he implemented (ice-9 suspendable-ports).

       Mark

Re: Unexpectedly low read/write performance of open-pipe

[Chris Vine]

On Tue, 09 Apr 2019 14:24:09 -0400
Mark H Weaver <mhw@netris.org> wrote:
> Hi Chris,
> Chris Vine <vine35792468@gmail.com> writes:
> > On Tue, 09 Apr 2019 04:35:38 -0400
> > Mark H Weaver <mhw@netris.org> wrote:
> >> 
> >> I think it's probably fine for 2.2, although a more careful check should
> >> be made for differences in behavior between the old and new
> >> implementations, and tests should be added.  I'll try to get to it soon.
> >
> > If it is going in 2.2 (or 3.0) it would be nice if the ports could be
> > suspendable.  put-bytevector (used by write!) is suspendable;
> > get-bytevector-some (used by read!) is not.
> 
> Unless I'm mistaken, nothing done within custom ports is suspendable,
> regardless of which I/O primitives are used, because the custom port
> implementations themselves are all written in C.  The custom port
> handlers such as 'read!' and 'write!' are always invoked from C code.
> Caleb Ristvedt recently ran into this problem and posted about it on
> guile-user:
> 
>   https://lists.gnu.org/archive/html/guile-user/2019-03/msg00032.html
> 
> I responded here:
> 
>   https://lists.gnu.org/archive/html/guile-user/2019-04/msg00000.html
> 
> I'm not sure off-hand what would be required to re-implement custom
> ports in suspendable Scheme code.  Andy Wingo would be a good person to
> ask, since he implemented (ice-9 suspendable-ports).

You are probably right about custom ports' implementations.  I
encountered a similar problem with guile-gnutls ports.  (In the case of
guile-gnutls, because TLS connections are one of the areas where you
would expect suspendable i/o to be useful, that is a shame.)

Chris

Re: Unexpectedly low read/write performance of open-pipe

[Mark H Weaver]

Hi again,

Earlier, I wrote:
> I'm not sure off-hand what would be required to re-implement custom
> ports in suspendable Scheme code.

I finally dug into this code, and was delighted to find that Andy Wingo
has already laid the groundwork to avoid going through C code in our
custom port handlers, in commit 8bad621fec65d58768a38661278165ae259fabce
from April 2016:

  https://git.savannah.gnu.org/cgit/guile.git/commit/?id=8bad621fec65d58768a38661278165ae259fabce

Given this, I think it will be fairly straightforward to modify our
custom ports to be suspendable.  Likewise, I see no difficulty in
implementing a suspendable version of 'get-bytevector-some'.

I'll work on it.

       Mark

Re: Unexpectedly low read/write performance of open-pipe

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 854 bytes --]

> Earlier, I wrote:
>> I'm not sure off-hand what would be required to re-implement custom
>> ports in suspendable Scheme code.
>
> I finally dug into this code, and was delighted to find that Andy Wingo
> has already laid the groundwork to avoid going through C code in our
> custom port handlers, in commit 8bad621fec65d58768a38661278165ae259fabce
> from April 2016:
>
>   https://git.savannah.gnu.org/cgit/guile.git/commit/?id=8bad621fec65d58768a38661278165ae259fabce
>
> Given this, I think it will be fairly straightforward to modify our
> custom ports to be suspendable.  Likewise, I see no difficulty in
> implementing a suspendable version of 'get-bytevector-some'.
>
> I'll work on it.

Here are preliminary patches to implement suspendable custom ports and
'get-bytevector-some', although I haven't yet given them much testing.

        Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] DRAFT: Add a suspendable implementation of 'get-bytevector-some' --]
[-- Type: text/x-patch, Size: 1936 bytes --]

From 271cbbc3acc40926c8311e8dcca757285a53f00d Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 14 Apr 2019 17:43:30 -0400
Subject: [PATCH] DRAFT: Add a suspendable implementation of
 'get-bytevector-some'.

---
 module/ice-9/suspendable-ports.scm | 17 +++++++++++++++--
 1 file changed, 15 insertions(+), 2 deletions(-)

diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm
index a366c8b9c..d91ffd3c1 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -1,5 +1,5 @@
 ;;; Ports, implemented in Scheme
-;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2016, 2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -292,6 +292,19 @@
        ((< (- count pos) (port-read-buffering port)) (buffer-and-fill pos))
        (else (fill-directly pos))))))
 
+(define (get-bytevector-some port)
+  (call-with-values (lambda () (fill-input port 1 'binary))
+    (lambda (buf cur buffered)
+      (if (zero? buffered)
+          (begin
+            (set-port-buffer-has-eof?! buf #f)
+            the-eof-object)
+          (let ((result (make-bytevector buffered)))
+            (bytevector-copy! (port-buffer-bytevector buf) cur
+                              result 0 buffered)
+            (set-port-buffer-cur! buf (+ cur buffered))
+            result)))))
+
 (define (put-u8 port byte)
   (let* ((buf (port-write-buffer port))
          (bv (port-buffer-bytevector buf))
@@ -702,7 +715,7 @@
      read-char peek-char force-output close-port
      accept connect)
     ((ice-9 binary-ports)
-     get-u8 lookahead-u8 get-bytevector-n
+     get-u8 lookahead-u8 get-bytevector-n get-bytevector-some
      put-u8 put-bytevector)
     ((ice-9 textual-ports)
      put-char put-string)
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: [PATCH] DRAFT: Make custom binary ports suspendable --]
[-- Type: text/x-patch, Size: 10556 bytes --]

From 57b1cb09a9c7b553ce35782605016430a355e237 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 14 Apr 2019 17:30:40 -0400
Subject: [PATCH] DRAFT: Make custom binary ports suspendable.

---
 libguile/r6rs-ports.c         | 136 +++++++++++++++++++++-------------
 module/ice-9/binary-ports.scm |  24 +++++-
 2 files changed, 107 insertions(+), 53 deletions(-)

diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index c1cbbdf30..577bcdffd 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 2009, 2010, 2011, 2013-2015, 2018 Free Software Foundation, Inc.
+/* Copyright (C) 2009-2011, 2013-2015, 2018, 2019
+ *   Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -289,24 +290,6 @@ make_custom_binary_input_port (SCM read_proc, SCM get_position_proc,
                                         (scm_t_bits) stream);
 }
 
-static size_t
-custom_binary_input_port_read (SCM port, SCM dst, size_t start, size_t count)
-#define FUNC_NAME "custom_binary_input_port_read"
-{
-  struct custom_binary_port *stream = (void *) SCM_STREAM (port);
-  SCM octets;
-  size_t c_octets;
-
-  octets = scm_call_3 (stream->read, dst, scm_from_size_t (start),
-                       scm_from_size_t (count));
-  c_octets = scm_to_size_t (octets);
-  if (c_octets > count)
-    scm_out_of_range (FUNC_NAME, octets);
-
-  return c_octets;
-}
-#undef FUNC_NAME
-
 
 SCM_DEFINE (scm_make_custom_binary_input_port,
 	    "make-custom-binary-input-port", 5, 0, 0,
@@ -317,6 +300,9 @@ SCM_DEFINE (scm_make_custom_binary_input_port,
 	    "index where octets should be written, and an octet count.")
 #define FUNC_NAME s_scm_make_custom_binary_input_port
 {
+  /* Ensure that custom binary ports are initialized. */
+  scm_c_resolve_module ("ice-9 binary-ports");
+  
   SCM_VALIDATE_STRING (1, id);
   SCM_VALIDATE_PROC (2, read_proc);
 
@@ -340,9 +326,11 @@ static inline void
 initialize_custom_binary_input_ports (void)
 {
   custom_binary_input_port_type =
-    scm_make_port_type ("r6rs-custom-binary-input-port",
-			custom_binary_input_port_read, NULL);
+    scm_make_port_type ("r6rs-custom-binary-input-port", NULL, NULL);
 
+  scm_set_port_scm_read (custom_binary_input_port_type,
+                         scm_c_private_ref ("ice-9 binary-ports",
+                                            "custom-binary-port-read!"));
   scm_set_port_seek (custom_binary_input_port_type, custom_binary_port_seek);
   scm_set_port_random_access_p (custom_binary_input_port_type,
                                 custom_binary_port_random_access_p);
@@ -892,28 +880,6 @@ make_custom_binary_output_port (SCM write_proc, SCM get_position_proc,
                                         (scm_t_bits) stream);
 }
 
-/* Flush octets from BUF to the backing store.  */
-static size_t
-custom_binary_output_port_write (SCM port, SCM src, size_t start, size_t count)
-#define FUNC_NAME "custom_binary_output_port_write"
-{
-  struct custom_binary_port *stream = (void *) SCM_STREAM (port);
-  size_t written;
-  SCM result;
-
-  result = scm_call_3 (stream->write, src, scm_from_size_t (start),
-                       scm_from_size_t (count));
-
-  written = scm_to_size_t (result);
-  if (written > count)
-    scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
-                            "R6RS custom binary output port `write!' "
-                            "returned a incorrect integer");
-
-  return written;
-}
-#undef FUNC_NAME
-
 
 SCM_DEFINE (scm_make_custom_binary_output_port,
 	    "make-custom-binary-output-port", 5, 0, 0,
@@ -924,6 +890,9 @@ SCM_DEFINE (scm_make_custom_binary_output_port,
 	    "index where octets should be written, and an octet count.")
 #define FUNC_NAME s_scm_make_custom_binary_output_port
 {
+  /* Ensure that custom binary ports are initialized. */
+  scm_c_resolve_module ("ice-9 binary-ports");
+  
   SCM_VALIDATE_STRING (1, id);
   SCM_VALIDATE_PROC (2, write_proc);
 
@@ -947,9 +916,11 @@ static inline void
 initialize_custom_binary_output_ports (void)
 {
   custom_binary_output_port_type =
-    scm_make_port_type ("r6rs-custom-binary-output-port",
-			NULL, custom_binary_output_port_write);
+    scm_make_port_type ("r6rs-custom-binary-output-port", NULL, NULL);
 
+  scm_set_port_scm_write (custom_binary_output_port_type,
+                          scm_c_private_ref ("ice-9 binary-ports",
+                                             "custom-binary-port-write!"));
   scm_set_port_seek (custom_binary_output_port_type, custom_binary_port_seek);
   scm_set_port_random_access_p (custom_binary_output_port_type,
                                 custom_binary_port_random_access_p);
@@ -996,6 +967,9 @@ SCM_DEFINE (scm_make_custom_binary_input_output_port,
             "written, and an octet count.")
 #define FUNC_NAME s_scm_make_custom_binary_input_output_port
 {
+  /* Ensure that custom binary ports are initialized. */
+  scm_c_resolve_module ("ice-9 binary-ports");
+  
   SCM_VALIDATE_STRING (1, id);
   SCM_VALIDATE_PROC (2, read_proc);
   SCM_VALIDATE_PROC (3, write_proc);
@@ -1020,10 +994,14 @@ static inline void
 initialize_custom_binary_input_output_ports (void)
 {
   custom_binary_input_output_port_type =
-    scm_make_port_type ("r6rs-custom-binary-input/output-port",
-			custom_binary_input_port_read,
-			custom_binary_output_port_write);
-
+    scm_make_port_type ("r6rs-custom-binary-input/output-port", NULL, NULL);
+
+  scm_set_port_scm_read (custom_binary_input_output_port_type,
+                         scm_c_private_ref ("ice-9 binary-ports",
+                                            "custom-binary-port-read!"));
+  scm_set_port_scm_write (custom_binary_input_output_port_type,
+                          scm_c_private_ref ("ice-9 binary-ports",
+                                             "custom-binary-port-write!"));
   scm_set_port_seek (custom_binary_input_output_port_type,
                      custom_binary_port_seek);
   scm_set_port_random_access_p (custom_binary_input_output_port_type,
@@ -1035,6 +1013,56 @@ initialize_custom_binary_input_output_ports (void)
 
 \f
 
+/* Internal accessors needed by 'custom-binary-port-read!' and
+   'custom-binary-port-write!'.  */
+
+SCM_INTERNAL SCM scm_i_custom_binary_port_reader (SCM);
+SCM_DEFINE (scm_i_custom_binary_port_reader,
+            "custom-binary-port-reader", 1, 0, 0,
+            (SCM port),
+            "Return the 'read!' procedure associated with PORT, "
+            "which must be custom binary input or input/output port.")
+#define FUNC_NAME s_scm_i_custom_binary_port_reader
+{
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  if (SCM_PORT_TYPE (port) == custom_binary_input_port_type ||
+      SCM_PORT_TYPE (port) == custom_binary_input_output_port_type)
+    {
+      struct custom_binary_port *stream = (void *) SCM_STREAM (port);
+      return stream->read;
+    }
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+                            "custom binary input or input/output port");
+}
+#undef FUNC_NAME
+
+SCM_INTERNAL SCM scm_i_custom_binary_port_writer (SCM);
+SCM_DEFINE (scm_i_custom_binary_port_writer,
+            "custom-binary-port-writer", 1, 0, 0,
+            (SCM port),
+            "Return the 'write!' procedure associated with PORT, "
+            "which must be custom binary output or input/output port.")
+#define FUNC_NAME s_scm_i_custom_binary_port_writer
+{
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+
+  if (SCM_PORT_TYPE (port) == custom_binary_output_port_type ||
+      SCM_PORT_TYPE (port) == custom_binary_input_output_port_type)
+    {
+      struct custom_binary_port *stream = (void *) SCM_STREAM (port);
+      return stream->write;
+    }
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+                            "custom binary output or input/output port");
+}
+#undef FUNC_NAME
+
+
+\f
+
 /* Transcoded ports.  */
 
 static scm_t_port_type *transcoded_port_type = 0;
@@ -1160,15 +1188,19 @@ scm_register_r6rs_ports (void)
 			    NULL);
 
   initialize_bytevector_input_ports ();
-  initialize_custom_binary_input_ports ();
   initialize_bytevector_output_ports ();
-  initialize_custom_binary_output_ports ();
-  initialize_custom_binary_input_output_ports ();
   initialize_transcoded_ports ();
 }
 
 void
 scm_init_r6rs_ports (void)
 {
+  /* We postpone registering custom binary ports until (ice-9 binary-ports)
+   * is loaded, because these custom port types depend on Scheme procedures
+   * defined there.  */
+  initialize_custom_binary_input_ports ();
+  initialize_custom_binary_output_ports ();
+  initialize_custom_binary_input_output_ports ();
+
 #include "libguile/r6rs-ports.x"
 }
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index e0da3df1a..6389c9be8 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -1,6 +1,6 @@
 ;;;; binary-ports.scm --- Binary IO on ports
 
-;;;;	Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2011, 2013, 2019 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -45,6 +45,28 @@
             make-custom-binary-output-port
             make-custom-binary-input/output-port))
 
+(define (custom-binary-port-read! port bv start count)
+  (let* ((read! (custom-binary-port-reader port))
+         (result (read! bv start count)))
+    (unless (and (exact-integer? result)
+                 (<= 0 result count))
+      (scm-error 'out-of-range #f
+                 "custom port 'read!' (~S) returned value out of range; expected an exact integer between 0 and ~A, got ~A"
+                 (list read! count result)
+                 (list result)))
+    result))
+
+(define (custom-binary-port-write! port bv start count)
+  (let* ((write! (custom-binary-port-writer port))
+         (result (write! bv start count)))
+    (unless (and (exact-integer? result)
+                 (<= 0 result count))
+      (scm-error 'out-of-range #f
+                 "custom port 'write!' (~S) returned value out of range; expected an exact integer between 0 and ~A, got ~A"
+                 (list write! count result)
+                 (list result)))
+    result))
+
 ;; Note that this extension also defines %make-transcoded-port, which is
 ;; not exported but is used by (rnrs io ports).
 
-- 
2.21.0

Re: Unexpectedly low read/write performance of open-pipe

[Mark H Weaver]

Chris Vine <vine35792468@gmail.com> writes:

> On Tue, 09 Apr 2019 04:35:38 -0400
> Mark H Weaver <mhw@netris.org> wrote:
>>
>> I think it's probably fine for 2.2, although a more careful check should
>> be made for differences in behavior between the old and new
>> implementations, and tests should be added.  I'll try to get to it soon.
>
> If it is going in 2.2 (or 3.0) it would be nice if the ports could be
> suspendable.  put-bytevector (used by write!) is suspendable;
> get-bytevector-some (used by read!) is not.

In my previous message, I forgot to mention that I don't believe my
patch would introduce a regression here, because the old implementation
of 'open-pipe*' in OPEN_BOTH mode _also_ used a kind of custom port
implemented in C, namely Guile's old "soft ports".

That said, I certainly agree that it would be good to make more I/O
operations suspendable, and to make custom ports suspendable as well.

       Mark

Re: Unexpectedly low read/write performance of open-pipe

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 1930 bytes --]

Hi Rob,

Rob Browning <rlb@defaultvalue.org> writes:
> For a first quick test of your patch using the original program I was
> working on, I see about ~1.4MiB/s without the patch, and about 150MiB/s
> with it, measured by pv.
>
> (If the patch holds up, it'd be nice to have in 2.2, but I suppose that
>  might not be appropriate.)

I've made more improvements, and now your attached test is able to
discard /dev/zero via OPEN_BOTH at ~1267 mb/s on my Thinkpad X200.
That's only a little bit slower than the same test with OPEN_READ, which
discards at ~1462 mb/s on my machine.

  scheme@(guile-user)> (display "discarding dev-zero via OPEN_READ: " (current-error-port))
  (time-cat-mb 10000 (cat-zero OPEN_READ) *discard*)
  discarding dev-zero via OPEN_READ: 1461.99 mb/s
  $9 = #t
  scheme@(guile-user)> (display "discarding dev-zero via OPEN_BOTH: " (current-error-port))
  (time-cat-mb 10000 (cat-zero OPEN_BOTH) *discard*)
  discarding dev-zero via OPEN_BOTH: 1267.43 mb/s
  $10 = #t

The key improvement over my last version is that I added a new primitive
'get-bytevector-some!', which (1) copies the data into an existing
bytevector, and (2) allows you to specify a maximum read size, which is
of course now necessary.

Crucially, this allows the data to pass through without any heap
allocation.  Previously, every call to the custom 'read!' procedure
allocated a fresh bytevector.  Also, it radically simplifies the 'read!'
procedure:

  (define (read! bv start count)
    (get-bytevector-some! read-port bv start count))

I've attached four patches.  Only the first two should be needed for
what I have described above.

The last two patches will only be of interest if you need suspendable
I/O.  They add suspendable I/O support for custom binary ports, and in
particular for these OPEN_BOTH pipe ports.

Note that I've not yet done much testing of these patches, besides
running the Guile test suite.

       Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH 1/4] DRAFT: Add get-bytevector-some! --]
[-- Type: text/x-patch, Size: 3382 bytes --]

From 14dec723707ee766642397962fa93124d9c86811 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 16 Apr 2019 23:14:27 -0400
Subject: [PATCH 1/4] DRAFT: Add get-bytevector-some!.

---
 libguile/r6rs-ports.c         | 37 +++++++++++++++++++++++++++++++++++
 libguile/r6rs-ports.h         |  5 ++++-
 module/ice-9/binary-ports.scm |  1 +
 3 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index c1cbbdf30..9b64696a6 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -502,6 +502,43 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_get_bytevector_some_x, "get-bytevector-some!", 4, 0, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+            "Read up to @var{count} bytes from @var{port}, blocking "
+            "as necessary until at least one byte is available or an "
+            "end-of-file is reached.  Store them in @var{bv} starting "
+            "at index @var{start}.  Return the number of bytes actually "
+            "read, or 0 if an end-of-file was reached.")
+#define FUNC_NAME s_scm_get_bytevector_some_x
+{
+  SCM buf;
+  size_t c_start, c_count, c_len;
+  size_t cur, avail, transfer_size;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+  c_start = scm_to_size_t (start);
+  c_count = scm_to_size_t (count);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  if (SCM_UNLIKELY (c_start + c_count > c_len ||
+                    c_count == 0))
+    scm_out_of_range (FUNC_NAME, count);
+
+  buf = scm_fill_input (port, 0, &cur, &avail);
+  transfer_size = min (avail, c_count);
+
+  if (transfer_size == 0)
+    scm_port_buffer_set_has_eof_p (buf, SCM_BOOL_F);
+  else
+    scm_port_buffer_take
+      (buf, ((scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv)) + c_start,
+       transfer_size, cur, avail);
+  
+  return scm_from_size_t (transfer_size);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
 	    (SCM port),
 	    "Read from @var{port}, blocking as necessary, until "
diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h
index a2c63c7f4..7dfa382ef 100644
--- a/libguile/r6rs-ports.h
+++ b/libguile/r6rs-ports.h
@@ -1,7 +1,7 @@
 #ifndef SCM_R6RS_PORTS_H
 #define SCM_R6RS_PORTS_H
 
-/* Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2009-2011, 2013, 2019 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -46,4 +46,7 @@ SCM_API SCM scm_get_string_n_x (SCM, SCM, SCM, SCM);
 SCM_API void scm_init_r6rs_ports (void);
 SCM_INTERNAL void scm_register_r6rs_ports (void);
 
+/* Guile extensions, not in R6RS.  */
+SCM_API SCM scm_get_bytevector_some_x (SCM, SCM, SCM, SCM);
+
 #endif /* SCM_R6RS_PORTS_H */
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index e0da3df1a..62fd9786f 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -36,6 +36,7 @@
             get-bytevector-n
             get-bytevector-n!
             get-bytevector-some
+            get-bytevector-some!  ; Guile extension, not in R6RS
             get-bytevector-all
             get-string-n!
             put-u8
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: [PATCH 2/4] DRAFT: open-pipe*: Improve performance of OPEN_BOTH mode --]
[-- Type: text/x-patch, Size: 3479 bytes --]

From 0dbb4989245305f79e053e49330434230fd14cee Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Mon, 8 Apr 2019 06:22:41 -0400
Subject: [PATCH 2/4] DRAFT: open-pipe*: Improve performance of OPEN_BOTH mode.

* module/ice-9/popen.scm (make-rw-port): Re-implement using R6RS custom
binary input/output ports.
---
 module/ice-9/popen.scm | 56 +++++++++++++++++++++++++++++++-----------
 1 file changed, 42 insertions(+), 14 deletions(-)

diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm
index b166e9d0f..1724b5a7e 100644
--- a/module/ice-9/popen.scm
+++ b/module/ice-9/popen.scm
@@ -1,7 +1,7 @@
 ;; popen emulation, for non-stdio based ports.
 
-;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2006, 2010, 2011, 2012,
-;;;;   2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 1998-2001, 2003, 2006, 2010-2013, 2019
+;;;;   Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,10 +19,12 @@
 ;;;; 
 
 (define-module (ice-9 popen)
-  :use-module (ice-9 threads)
-  :use-module (srfi srfi-9)
-  :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
-	   open-output-pipe open-input-output-pipe))
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-9)
+  #:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
+            open-output-pipe open-input-output-pipe))
 
 (eval-when (expand load eval)
   (load-extension (string-append "libguile-" (effective-version))
@@ -34,14 +36,40 @@
   (pid pipe-info-pid set-pipe-info-pid!))
 
 (define (make-rw-port read-port write-port)
-  (make-soft-port
-   (vector
-    (lambda (c) (write-char c write-port))
-    (lambda (s) (display s write-port))
-    (lambda () (force-output write-port))
-    (lambda () (read-char read-port))
-    (lambda () (close-port read-port) (close-port write-port)))
-   "r+"))
+  (define (read! bv start count)
+    (get-bytevector-some! read-port bv start count))
+
+  (define (write! bv start count)
+    (put-bytevector write-port bv start count)
+    count)
+
+  (define (close)
+    (close-port read-port)
+    (close-port write-port))
+
+  (define rw-port
+    (make-custom-binary-input/output-port "ice-9-popen-rw-port"
+                                          read!
+                                          write!
+                                          #f ;get-position
+                                          #f ;set-position!
+                                          close))
+  ;; Enable buffering on 'read-port' so that 'get-bytevector-some' will
+  ;; return non-trivial blocks.
+  (setvbuf read-port 'block 65536)
+
+  ;; Inherit the port-encoding from the read-port.
+  (set-port-encoding! rw-port (port-encoding read-port))
+
+  ;; Reset the port encoding on the underlying ports to inhibit BOM
+  ;; handling there.  Instead, the BOM handling (if any) will be handled
+  ;; in the rw-port.  In the current implementation of Guile ports,
+  ;; using binary I/O primitives alone is not enough to reliably inhibit
+  ;; BOM handling, if the port encoding is set to UTF-{8,16,32}.
+  (set-port-encoding! read-port "ISO-8859-1")
+  (set-port-encoding! write-port "ISO-8859-1")
+
+  rw-port)
 
 ;; a guardian to ensure the cleanup is done correctly when
 ;; an open pipe is gc'd or a close-port is used.
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: [PATCH 3/4] DRAFT: Make 'get-bytevector-some' and 'get-bytevector-some!' suspendable --]
[-- Type: text/x-patch, Size: 2424 bytes --]

From be411941ddf79561b168ae15f1f1bec96d1305ed Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 16 Apr 2019 23:14:58 -0400
Subject: [PATCH 3/4] DRAFT: Make 'get-bytevector-some' and
 'get-bytevector-some!' suspendable.

---
 module/ice-9/suspendable-ports.scm | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm
index a366c8b9c..96107c43d 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -1,5 +1,5 @@
 ;;; Ports, implemented in Scheme
-;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2016, 2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -292,6 +292,32 @@
        ((< (- count pos) (port-read-buffering port)) (buffer-and-fill pos))
        (else (fill-directly pos))))))
 
+(define (get-bytevector-some port)
+  (call-with-values (lambda () (fill-input port 1 'binary))
+    (lambda (buf cur buffered)
+      (if (zero? buffered)
+          (begin
+            (set-port-buffer-has-eof?! buf #f)
+            the-eof-object)
+          (let ((result (make-bytevector buffered)))
+            (bytevector-copy! (port-buffer-bytevector buf) cur
+                              result 0 buffered)
+            (set-port-buffer-cur! buf (+ cur buffered))
+            result)))))
+
+(define (get-bytevector-some! port bv start count)
+  (call-with-values (lambda () (fill-input port 1 'binary))
+    (lambda (buf cur buffered)
+      (if (zero? buffered)
+          (begin
+            (set-port-buffer-has-eof?! buf #f)
+            0)
+          (let ((transfer-size (min count buffered)))
+            (bytevector-copy! (port-buffer-bytevector buf) cur
+                              transfer-size start buffered)
+            (set-port-buffer-cur! buf (+ cur transfer-size))
+            transfer-size)))))
+
 (define (put-u8 port byte)
   (let* ((buf (port-write-buffer port))
          (bv (port-buffer-bytevector buf))
@@ -703,6 +729,7 @@
      accept connect)
     ((ice-9 binary-ports)
      get-u8 lookahead-u8 get-bytevector-n
+     get-bytevector-some get-bytevector-some!
      put-u8 put-bytevector)
     ((ice-9 textual-ports)
      put-char put-string)
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: [PATCH 4/4] DRAFT: Make custom binary ports suspendable --]
[-- Type: text/x-patch, Size: 10563 bytes --]

From 7cbf017e1656a450c5925414df2f0a751a6ba6c2 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 14 Apr 2019 17:30:40 -0400
Subject: [PATCH 4/4] DRAFT: Make custom binary ports suspendable.

---
 libguile/r6rs-ports.c         | 136 +++++++++++++++++++++-------------
 module/ice-9/binary-ports.scm |  24 +++++-
 2 files changed, 107 insertions(+), 53 deletions(-)

diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 9b64696a6..9c4f2c8da 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 2009, 2010, 2011, 2013-2015, 2018 Free Software Foundation, Inc.
+/* Copyright (C) 2009-2011, 2013-2015, 2018, 2019
+ *   Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -289,24 +290,6 @@ make_custom_binary_input_port (SCM read_proc, SCM get_position_proc,
                                         (scm_t_bits) stream);
 }
 
-static size_t
-custom_binary_input_port_read (SCM port, SCM dst, size_t start, size_t count)
-#define FUNC_NAME "custom_binary_input_port_read"
-{
-  struct custom_binary_port *stream = (void *) SCM_STREAM (port);
-  SCM octets;
-  size_t c_octets;
-
-  octets = scm_call_3 (stream->read, dst, scm_from_size_t (start),
-                       scm_from_size_t (count));
-  c_octets = scm_to_size_t (octets);
-  if (c_octets > count)
-    scm_out_of_range (FUNC_NAME, octets);
-
-  return c_octets;
-}
-#undef FUNC_NAME
-
 
 SCM_DEFINE (scm_make_custom_binary_input_port,
 	    "make-custom-binary-input-port", 5, 0, 0,
@@ -317,6 +300,9 @@ SCM_DEFINE (scm_make_custom_binary_input_port,
 	    "index where octets should be written, and an octet count.")
 #define FUNC_NAME s_scm_make_custom_binary_input_port
 {
+  /* Ensure that custom binary ports are initialized. */
+  scm_c_resolve_module ("ice-9 binary-ports");
+  
   SCM_VALIDATE_STRING (1, id);
   SCM_VALIDATE_PROC (2, read_proc);
 
@@ -340,9 +326,11 @@ static inline void
 initialize_custom_binary_input_ports (void)
 {
   custom_binary_input_port_type =
-    scm_make_port_type ("r6rs-custom-binary-input-port",
-			custom_binary_input_port_read, NULL);
+    scm_make_port_type ("r6rs-custom-binary-input-port", NULL, NULL);
 
+  scm_set_port_scm_read (custom_binary_input_port_type,
+                         scm_c_private_ref ("ice-9 binary-ports",
+                                            "custom-binary-port-read!"));
   scm_set_port_seek (custom_binary_input_port_type, custom_binary_port_seek);
   scm_set_port_random_access_p (custom_binary_input_port_type,
                                 custom_binary_port_random_access_p);
@@ -929,28 +917,6 @@ make_custom_binary_output_port (SCM write_proc, SCM get_position_proc,
                                         (scm_t_bits) stream);
 }
 
-/* Flush octets from BUF to the backing store.  */
-static size_t
-custom_binary_output_port_write (SCM port, SCM src, size_t start, size_t count)
-#define FUNC_NAME "custom_binary_output_port_write"
-{
-  struct custom_binary_port *stream = (void *) SCM_STREAM (port);
-  size_t written;
-  SCM result;
-
-  result = scm_call_3 (stream->write, src, scm_from_size_t (start),
-                       scm_from_size_t (count));
-
-  written = scm_to_size_t (result);
-  if (written > count)
-    scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
-                            "R6RS custom binary output port `write!' "
-                            "returned a incorrect integer");
-
-  return written;
-}
-#undef FUNC_NAME
-
 
 SCM_DEFINE (scm_make_custom_binary_output_port,
 	    "make-custom-binary-output-port", 5, 0, 0,
@@ -961,6 +927,9 @@ SCM_DEFINE (scm_make_custom_binary_output_port,
 	    "index where octets should be written, and an octet count.")
 #define FUNC_NAME s_scm_make_custom_binary_output_port
 {
+  /* Ensure that custom binary ports are initialized. */
+  scm_c_resolve_module ("ice-9 binary-ports");
+  
   SCM_VALIDATE_STRING (1, id);
   SCM_VALIDATE_PROC (2, write_proc);
 
@@ -984,9 +953,11 @@ static inline void
 initialize_custom_binary_output_ports (void)
 {
   custom_binary_output_port_type =
-    scm_make_port_type ("r6rs-custom-binary-output-port",
-			NULL, custom_binary_output_port_write);
+    scm_make_port_type ("r6rs-custom-binary-output-port", NULL, NULL);
 
+  scm_set_port_scm_write (custom_binary_output_port_type,
+                          scm_c_private_ref ("ice-9 binary-ports",
+                                             "custom-binary-port-write!"));
   scm_set_port_seek (custom_binary_output_port_type, custom_binary_port_seek);
   scm_set_port_random_access_p (custom_binary_output_port_type,
                                 custom_binary_port_random_access_p);
@@ -1033,6 +1004,9 @@ SCM_DEFINE (scm_make_custom_binary_input_output_port,
             "written, and an octet count.")
 #define FUNC_NAME s_scm_make_custom_binary_input_output_port
 {
+  /* Ensure that custom binary ports are initialized. */
+  scm_c_resolve_module ("ice-9 binary-ports");
+  
   SCM_VALIDATE_STRING (1, id);
   SCM_VALIDATE_PROC (2, read_proc);
   SCM_VALIDATE_PROC (3, write_proc);
@@ -1057,10 +1031,14 @@ static inline void
 initialize_custom_binary_input_output_ports (void)
 {
   custom_binary_input_output_port_type =
-    scm_make_port_type ("r6rs-custom-binary-input/output-port",
-			custom_binary_input_port_read,
-			custom_binary_output_port_write);
-
+    scm_make_port_type ("r6rs-custom-binary-input/output-port", NULL, NULL);
+
+  scm_set_port_scm_read (custom_binary_input_output_port_type,
+                         scm_c_private_ref ("ice-9 binary-ports",
+                                            "custom-binary-port-read!"));
+  scm_set_port_scm_write (custom_binary_input_output_port_type,
+                          scm_c_private_ref ("ice-9 binary-ports",
+                                             "custom-binary-port-write!"));
   scm_set_port_seek (custom_binary_input_output_port_type,
                      custom_binary_port_seek);
   scm_set_port_random_access_p (custom_binary_input_output_port_type,
@@ -1072,6 +1050,56 @@ initialize_custom_binary_input_output_ports (void)
 
 \f
 
+/* Internal accessors needed by 'custom-binary-port-read!' and
+   'custom-binary-port-write!'.  */
+
+SCM_INTERNAL SCM scm_i_custom_binary_port_reader (SCM);
+SCM_DEFINE (scm_i_custom_binary_port_reader,
+            "custom-binary-port-reader", 1, 0, 0,
+            (SCM port),
+            "Return the 'read!' procedure associated with PORT, "
+            "which must be custom binary input or input/output port.")
+#define FUNC_NAME s_scm_i_custom_binary_port_reader
+{
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  if (SCM_PORT_TYPE (port) == custom_binary_input_port_type ||
+      SCM_PORT_TYPE (port) == custom_binary_input_output_port_type)
+    {
+      struct custom_binary_port *stream = (void *) SCM_STREAM (port);
+      return stream->read;
+    }
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+                            "custom binary input or input/output port");
+}
+#undef FUNC_NAME
+
+SCM_INTERNAL SCM scm_i_custom_binary_port_writer (SCM);
+SCM_DEFINE (scm_i_custom_binary_port_writer,
+            "custom-binary-port-writer", 1, 0, 0,
+            (SCM port),
+            "Return the 'write!' procedure associated with PORT, "
+            "which must be custom binary output or input/output port.")
+#define FUNC_NAME s_scm_i_custom_binary_port_writer
+{
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+
+  if (SCM_PORT_TYPE (port) == custom_binary_output_port_type ||
+      SCM_PORT_TYPE (port) == custom_binary_input_output_port_type)
+    {
+      struct custom_binary_port *stream = (void *) SCM_STREAM (port);
+      return stream->write;
+    }
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+                            "custom binary output or input/output port");
+}
+#undef FUNC_NAME
+
+
+\f
+
 /* Transcoded ports.  */
 
 static scm_t_port_type *transcoded_port_type = 0;
@@ -1197,15 +1225,19 @@ scm_register_r6rs_ports (void)
 			    NULL);
 
   initialize_bytevector_input_ports ();
-  initialize_custom_binary_input_ports ();
   initialize_bytevector_output_ports ();
-  initialize_custom_binary_output_ports ();
-  initialize_custom_binary_input_output_ports ();
   initialize_transcoded_ports ();
 }
 
 void
 scm_init_r6rs_ports (void)
 {
+  /* We postpone registering custom binary ports until (ice-9 binary-ports)
+   * is loaded, because these custom port types depend on Scheme procedures
+   * defined there.  */
+  initialize_custom_binary_input_ports ();
+  initialize_custom_binary_output_ports ();
+  initialize_custom_binary_input_output_ports ();
+
 #include "libguile/r6rs-ports.x"
 }
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index 62fd9786f..70c6577dd 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -1,6 +1,6 @@
 ;;;; binary-ports.scm --- Binary IO on ports
 
-;;;;	Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2011, 2013, 2019 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -46,6 +46,28 @@
             make-custom-binary-output-port
             make-custom-binary-input/output-port))
 
+(define (custom-binary-port-read! port bv start count)
+  (let* ((read! (custom-binary-port-reader port))
+         (result (read! bv start count)))
+    (unless (and (exact-integer? result)
+                 (<= 0 result count))
+      (scm-error 'out-of-range #f
+                 "custom port 'read!' (~S) returned value out of range; expected an exact integer between 0 and ~A, got ~A"
+                 (list read! count result)
+                 (list result)))
+    result))
+
+(define (custom-binary-port-write! port bv start count)
+  (let* ((write! (custom-binary-port-writer port))
+         (result (write! bv start count)))
+    (unless (and (exact-integer? result)
+                 (<= 0 result count))
+      (scm-error 'out-of-range #f
+                 "custom port 'write!' (~S) returned value out of range; expected an exact integer between 0 and ~A, got ~A"
+                 (list write! count result)
+                 (list result)))
+    result))
+
 ;; Note that this extension also defines %make-transcoded-port, which is
 ;; not exported but is used by (rnrs io ports).
 
-- 
2.21.0

Re: Unexpectedly low read/write performance of open-pipe

[Rob Browning]

Mark H Weaver <mhw@netris.org> writes:

> I've attached four patches.  Only the first two should be needed for
> what I have described above.
>
> The last two patches will only be of interest if you need suspendable
> I/O.  They add suspendable I/O support for custom binary ports, and in
> particular for these OPEN_BOTH pipe ports.
>
> Note that I've not yet done much testing of these patches, besides
> running the Guile test suite.

Here for "guile -s io-perf.scm > /dev/null" I see:

  2.2.4:                  1.39 mb/s  >100% CPU in top
  your first proposal: 1453.49 mb/s  >300% CPU in top
  this series:         3937.01 mb/s   <80% CPU in top

(and most importantly for this series, a much quieter fan...)

And yes, I'd love to see something like this in 2.2 too if it turns out
to be feasible to include it there.

Nice
-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

Re: Unexpectedly low read/write performance of open-pipe

[Arne Babenhauserheide]

[-- Attachment #1: Type: text/plain, Size: 622 bytes --]


Rob Browning <rlb@defaultvalue.org> writes:
>> For something similar to the original python code and roughly similar to
>> open-pipe OPEN_BOTH (see code below) I see:
>>   mb/s: 1713.26754296

> Here for "guile -s io-perf.scm > /dev/null" I see:
>
>   2.2.4:                  1.39 mb/s  >100% CPU in top
>   your first proposal: 1453.49 mb/s  >300% CPU in top
>   this series:         3937.01 mb/s   <80% CPU in top

Is this still on the same machine? If yes, then it would show a more
than 2x speedup cmpared to Python!

Best wishes,
Arne
--
Unpolitisch sein
heißt politisch sein
ohne es zu merken

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 1076 bytes --]

Re: Unexpectedly low read/write performance of open-pipe

[tomas]

[-- Attachment #1: Type: text/plain, Size: 243 bytes --]

Just wow.

I was aware for a while that Guile's I/O "story" wasn't stellar.
So I was watching this thread, as my awe grew, mail by mail.

Thanks Rob, Mark and all the others. This was really impressive.

You rock.

Cheers
-- tomás

[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 198 bytes --]