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

[Mark H Weaver]

> 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


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

>From 57b1cb09a9c7b553ce35782605016430a355e237 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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)
 
 
 
+/* 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
+
+
+
+
 /* 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