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

[Mark H Weaver]

Hi Rob,

Rob Browning <address@hidden> writes:

> Rob Browning <address@hidden> 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


>From 4612e23994a012ef97e345a927fe9d0f232e78ab Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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