[Guile-commits] 02/05: Add SCM port read/write functions

[Andy Wingo]

wingo pushed a commit to branch wip-port-refactor
in repository guile.

commit 8bad621fec65d58768a38661278165ae259fabce
Author: Andy Wingo <address@hidden>
Date:   Sat Apr 30 11:59:33 2016 +0200

    Add SCM port read/write functions
    
    * libguile/ports.h (scm_t_ptob_descriptor): Add "scm_read" and
      "scm_write" members, for calling from Scheme.
      (scm_set_port_scm_read, scm_set_port_scm_write): New procedures.
    * libguile/ports.c (trampoline_to_c_read_subr)
      (trampoline_to_c_write_subr): New static variables.
    * libguile/ports.c (scm_make_port_type): Initialize scm_read and
      scm_write members to trampoline to C.
      (trampoline_to_c_read, trampoline_to_scm_read)
      (trampoline_to_c_write, trampoline_to_scm_write): New helpers.
      (scm_set_port_scm_read, scm_set_port_scm_write): New functions.
      (default_buffer_size): Move definition down.
      (scm_i_read_bytes, scm_i_write_bytes): Use new names for read and
      write procedures.
      (scm_init_ports): Initialize trampolines.
---
 libguile/ports.c |   72 +++++++++++++++++++++++++++++++++++++++++++++++++-----
 libguile/ports.h |    9 +++++--
 2 files changed, 73 insertions(+), 8 deletions(-)

diff --git a/libguile/ports.c b/libguile/ports.c
index 75bd1dd..8c8276b 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -224,8 +224,8 @@ scm_c_port_type_add_x (scm_t_ptob_descriptor *desc)
   return ret;
 }
 
-/* Default buffer size.  Used if the port type won't supply a value.  */
-static const size_t default_buffer_size = 1024;
+static SCM trampoline_to_c_read_subr;
+static SCM trampoline_to_c_write_subr;
 
 scm_t_bits
 scm_make_port_type (char *name,
@@ -242,8 +242,10 @@ scm_make_port_type (char *name,
 
   desc->name = name;
   desc->print = scm_port_print;
-  desc->read = read;
-  desc->write = write;
+  desc->c_read = read;
+  desc->c_write = write;
+  desc->scm_read = read ? trampoline_to_c_read_subr : SCM_BOOL_F;
+  desc->scm_write = write ? trampoline_to_c_write_subr : SCM_BOOL_F;
 
   ptobnum = scm_c_port_type_add_x (desc);
 
@@ -254,6 +256,54 @@ scm_make_port_type (char *name,
   return scm_tc7_port + ptobnum * 256;
 }
 
+static SCM
+trampoline_to_c_read (SCM port, SCM dst, SCM start, SCM count)
+{
+  return scm_from_size_t
+    (SCM_PORT_DESCRIPTOR (port)->c_read
+     (port, dst, scm_to_size_t (start), scm_to_size_t (count)));
+}
+
+static size_t
+trampoline_to_scm_read (SCM port, SCM dst, size_t start, size_t count)
+{
+  return scm_to_size_t
+    (scm_call_4 (SCM_PORT_DESCRIPTOR (port)->scm_read, port, dst,
+                 scm_from_size_t (start), scm_from_size_t (count)));
+}
+
+static SCM
+trampoline_to_c_write (SCM port, SCM src, SCM start, SCM count)
+{
+  return scm_from_size_t
+    (SCM_PORT_DESCRIPTOR (port)->c_write
+     (port, src, scm_to_size_t (start), scm_to_size_t (count)));
+}
+
+static size_t
+trampoline_to_scm_write (SCM port, SCM src, size_t start, size_t count)
+{
+  return scm_to_size_t
+    (scm_call_4 (SCM_PORT_DESCRIPTOR (port)->scm_write, port, src,
+                 scm_from_size_t (start), scm_from_size_t (count)));
+}
+
+void
+scm_set_port_scm_read (scm_t_bits tc, SCM read)
+{
+  scm_t_ptob_descriptor *desc = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
+  desc->scm_read = read;
+  desc->c_read = trampoline_to_scm_read;
+}
+
+void
+scm_set_port_scm_write (scm_t_bits tc, SCM write)
+{
+  scm_t_ptob_descriptor *desc = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
+  desc->scm_write = write;
+  desc->c_write = trampoline_to_scm_write;
+}
+
 void
 scm_set_port_print (scm_t_bits tc, int (*print) (SCM exp, SCM port,
                                                  scm_print_state *pstate))
@@ -637,6 +687,9 @@ finalize_port (void *ptr, void *data)
 
 
 
+/* Default buffer size.  Used if the port type won't supply a value.  */
+static const size_t default_buffer_size = 1024;
+
 static void
 initialize_port_buffers (SCM port)
 {
@@ -1417,7 +1470,7 @@ scm_i_read_bytes (SCM port, SCM dst, size_t start, size_t 
count)
   assert (count <= SCM_BYTEVECTOR_LENGTH (dst));
   assert (start + count <= SCM_BYTEVECTOR_LENGTH (dst));
 
-  filled = ptob->read (port, dst, start, count);
+  filled = ptob->c_read (port, dst, start, count);
 
   assert (filled <= count);
 
@@ -2473,7 +2526,7 @@ scm_i_write_bytes (SCM port, SCM src, size_t start, 
size_t count)
   assert (start + count <= SCM_BYTEVECTOR_LENGTH (src));
 
   do
-    written += ptob->write (port, src, start + written, count - written);
+    written += ptob->c_write (port, src, start + written, count - written);
   while (written < count);
 
   assert (written == count);
@@ -3108,6 +3161,13 @@ scm_init_ice_9_ports (void)
 void
 scm_init_ports (void)
 {
+  trampoline_to_c_read_subr =
+    scm_c_make_gsubr ("port-read", 4, 0, 0,
+                      (scm_t_subr) trampoline_to_c_read);
+  trampoline_to_c_write_subr =
+    scm_c_make_gsubr ("port-write", 4, 0, 0,
+                      (scm_t_subr) trampoline_to_c_write);
+
   scm_tc16_void_port = scm_make_port_type ("void", void_port_read,
                                           void_port_write);
 
diff --git a/libguile/ports.h b/libguile/ports.h
index 230137f..ba4bc2c 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -181,8 +181,11 @@ typedef struct scm_t_ptob_descriptor
   char *name;
   int (*print) (SCM exp, SCM port, scm_print_state *pstate);
 
-  size_t (*read) (SCM port, SCM dst, size_t start, size_t count);
-  size_t (*write) (SCM port, SCM src, size_t start, size_t count);
+  size_t (*c_read) (SCM port, SCM dst, size_t start, size_t count);
+  size_t (*c_write) (SCM port, SCM src, size_t start, size_t count);
+  SCM scm_read;
+  SCM scm_write;
+
   scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
   void (*close) (SCM port);
 
@@ -209,6 +212,8 @@ SCM_API scm_t_bits scm_make_port_type
        (char *name,
          size_t (*read) (SCM port, SCM dst, size_t start, size_t count),
          size_t (*write) (SCM port, SCM src, size_t start, size_t count));
+SCM_API void scm_set_port_scm_read (scm_t_bits tc, SCM read);
+SCM_API void scm_set_port_scm_write (scm_t_bits tc, SCM write);
 SCM_API void scm_set_port_print (scm_t_bits tc,
                                 int (*print) (SCM exp,
                                               SCM port,