[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Making custom binary input ports unbuffered
|
From: |
Mark H Weaver |
|
Subject: |
Re: Making custom binary input ports unbuffered |
|
Date: |
Tue, 21 Jan 2014 02:41:05 -0500 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) |
Here are the same changes adapted for master, where we can put the
new 'setvbuf' method where it belongs: in the PTOB.
Comments and suggestions welcome.
Mark
>From 00ee913e2da658f30d9d8682edfbb9a63719c370 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Tue, 21 Jan 2014 01:57:31 -0500
Subject: [PATCH 1/2] Prepare 'setvbuf' to support for non-file ports.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Based on a patch for Guile 2.0 by Ludovic Courtès.
* libguile/fports.c (scm_fport_buffer_add): Rename to 'fport_setvbuf'.
(fport_setvbuf): Renamed from 'scm_fport_buffer_add'. Change type of
'write_size' argument from 'int' to 'long'.
(scm_i_fdes_to_port): Adapt to renamed 'scm_fport_buffer_add'.
(scm_make_fptob): Set 'setvbuf' method to 'fport_setvbuf'.
(scm_setvbuf): Move to ports.c.
* libguile/ports.c (scm_make_port_type): Initialize 'setvbuf' field.
(scm_set_port_setvbuf): New API function.
(scm_setvbuf): Moved from fports.c. Accept any open port, and error
out when the ptob's 'setvbuf' field is NULL. Remove explicit
'scm_gc_free' calls. Call ptob's 'setvbuf' method instead of
'scm_fport_buffer_add'.
* libguile/fports.h (scm_setbuf0): Remove prototype for non-existent
function.
(scm_setvbuf): Move prototype to ports.h.
* libguile/ports.h (scm_t_ptob_descriptor): Add 'setvbuf' member.
(scm_set_port_setvbuf): Add prototype.
(scm_setvbuf): Move prototype here from fports.h.
* libguile/ports-internal.h (struct scm_port_internal): Change
'pending_eof' to a 1-bit unsigned char. Add comment for 'alist'
member.
* test-suite/tests/ports.test ("setvbuf")["closed port", "string port"]:
New tests.
* doc/ref/api-io.texi (Port Implementation): Document new 'setvbuf'
member of ptob, and 'scm_set_port_setvbuf'.
* doc/ref/posix.texi (Ports and File Descriptors): Suggest that
'setvbuf' works for different port types.
---
doc/ref/api-io.texi | 12 ++++-
doc/ref/posix.texi | 5 ++-
libguile/fports.c | 111 +++-------------------------------------
libguile/fports.h | 5 +-
libguile/ports-internal.h | 6 ++-
libguile/ports.c | 116 ++++++++++++++++++++++++++++++++++++++++++-
libguile/ports.h | 15 +++++-
test-suite/tests/ports.test | 14 +++++-
8 files changed, 172 insertions(+), 112 deletions(-)
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 5ca3506..edf38be 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009,
address@hidden 2010, 2011, 2013 Free Software Foundation, Inc.
address@hidden 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node Input and Output
@@ -2403,6 +2403,16 @@ Set using
@deftypefun void scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM
port, scm_t_off length))
@end deftypefun
address@hidden setvbuf
+Create read and write buffers for the port with the specified sizes (a
+size of 0 is for unbuffered ports, which should use the @code{shortbuf}
+field; a size of -1 means to use the port's preferred buffer size). It
+doesn't need to be set unless you wish to support @code{setvbuf}. Set
+using
+
address@hidden void scm_set_port_setvbuf (scm_t_bits tc, void (*setvbuf) (SCM
port, long read_size, long write_size))
address@hidden deftypefun
+
@end table
@node BOM Handling
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 40c20e7..0ced09b 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
address@hidden 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
address@hidden 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node POSIX
@@ -470,6 +470,9 @@ line buffered
block buffered, using a newly allocated buffer of @var{size} bytes.
If @var{size} is omitted, a default size will be used.
@end defvar
+
+Only certain types of ports are supported, most importantly
+file ports.
@end deffn
@deffn {Scheme Procedure} fcntl port/fd cmd [value]
diff --git a/libguile/fports.c b/libguile/fports.c
index dc3d45c..9f8f662 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,5 +1,6 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software
Foundation, Inc.
+ * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ * 2014 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
@@ -78,11 +79,11 @@ scm_t_bits scm_tc16_fport;
/* default buffer size, used if the O/S won't supply a value. */
static const size_t default_buffer_size = 1024;
-/* create FPORT buffer with specified sizes (or -1 to use default size or
- 0 for no buffer. */
+/* Create FPORT buffers with specified sizes (or -1 to use default size
+ or 0 for no buffer.) */
static void
-scm_fport_buffer_add (SCM port, long read_size, int write_size)
-#define FUNC_NAME "scm_fport_buffer_add"
+fport_setvbuf (SCM port, long read_size, long write_size)
+#define FUNC_NAME "fport_setvbuf"
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -136,101 +137,6 @@ scm_fport_buffer_add (SCM port, long read_size, int
write_size)
}
#undef FUNC_NAME
-SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
- (SCM port, SCM mode, SCM size),
- "Set the buffering mode for @var{port}. @var{mode} can be:\n"
- "@table @code\n"
- "@item _IONBF\n"
- "non-buffered\n"
- "@item _IOLBF\n"
- "line buffered\n"
- "@item _IOFBF\n"
- "block buffered, using a newly allocated buffer of @var{size}
bytes.\n"
- "If @var{size} is omitted, a default size will be used.\n"
- "@end table")
-#define FUNC_NAME s_scm_setvbuf
-{
- int cmode;
- long csize;
- size_t ndrained;
- char *drained;
- scm_t_port *pt;
-
- port = SCM_COERCE_OUTPORT (port);
-
- SCM_VALIDATE_OPFPORT (1,port);
- cmode = scm_to_int (mode);
- if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
- scm_out_of_range (FUNC_NAME, mode);
-
- if (cmode == _IOLBF)
- {
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
- cmode = _IOFBF;
- }
- else
- {
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) &
~(scm_t_bits)SCM_BUFLINE);
- }
-
- if (SCM_UNBNDP (size))
- {
- if (cmode == _IOFBF)
- csize = -1;
- else
- csize = 0;
- }
- else
- {
- csize = scm_to_int (size);
- if (csize < 0 || (cmode == _IONBF && csize > 0))
- scm_out_of_range (FUNC_NAME, size);
- }
-
- pt = SCM_PTAB_ENTRY (port);
-
- if (SCM_INPUT_PORT_P (port))
- {
- /* Drain pending input from PORT. Don't use `scm_drain_input' since
- it returns a string, whereas we want binary input here. */
- ndrained = pt->read_end - pt->read_pos;
- if (pt->read_buf == pt->putback_buf)
- ndrained += pt->saved_read_end - pt->saved_read_pos;
-
- if (ndrained > 0)
- {
- drained = scm_gc_malloc_pointerless (ndrained, "file port");
- scm_take_from_input_buffers (port, drained, ndrained);
- }
- }
- else
- ndrained = 0;
-
- if (SCM_OUTPUT_PORT_P (port))
- scm_flush_unlocked (port);
-
- if (pt->read_buf == pt->putback_buf)
- {
- pt->read_buf = pt->saved_read_buf;
- pt->read_pos = pt->saved_read_pos;
- pt->read_end = pt->saved_read_end;
- pt->read_buf_size = pt->saved_read_buf_size;
- }
- if (pt->read_buf != &pt->shortbuf)
- scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
- if (pt->write_buf != &pt->shortbuf)
- scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
-
- scm_fport_buffer_add (port, csize, csize);
-
- if (ndrained > 0)
- /* Put DRAINED back to PORT. */
- scm_unget_bytes ((unsigned char *) drained, ndrained, port);
-
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
/* Move ports with the specified file descriptor to new descriptors,
* resetting the revealed count to 0.
*/
@@ -574,9 +480,9 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
SCM_PTAB_ENTRY (port)->rw_random = SCM_FDES_RANDOM_P (fdes);
if (mode_bits & SCM_BUF0)
- scm_fport_buffer_add (port, 0, 0);
+ fport_setvbuf (port, 0, 0);
else
- scm_fport_buffer_add (port, -1, -1);
+ fport_setvbuf (port, -1, -1);
SCM_SET_FILENAME (port, name);
@@ -974,6 +880,7 @@ scm_make_fptob ()
scm_set_port_seek (tc, fport_seek);
scm_set_port_truncate (tc, fport_truncate);
scm_set_port_input_waiting (tc, fport_input_waiting);
+ scm_set_port_setvbuf (tc, fport_setvbuf);
return tc;
}
diff --git a/libguile/fports.h b/libguile/fports.h
index 092b43e..6eb2dd9 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,7 +3,8 @@
#ifndef SCM_FPORTS_H
#define SCM_FPORTS_H
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2011,
2012 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009,
+ * 2011, 2012, 2014 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
@@ -51,8 +52,6 @@ SCM_API scm_t_bits scm_tc16_fport;
#define SCM_FDES_RANDOM_P(fdes) ((lseek (fdes, 0, SEEK_CUR) == -1) ? 0 : 1)
-SCM_API SCM scm_setbuf0 (SCM port);
-SCM_API SCM scm_setvbuf (SCM port, SCM mode, SCM size);
SCM_API void scm_evict_ports (int fd);
SCM_API SCM scm_open_file_with_encoding (SCM filename, SCM modes,
SCM guess_encoding, SCM encoding);
diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h
index bff89cb..963dc21 100644
--- a/libguile/ports-internal.h
+++ b/libguile/ports-internal.h
@@ -1,7 +1,7 @@
/*
* ports-internal.h - internal-only declarations for ports.
*
- * Copyright (C) 2013 Free Software Foundation, Inc.
+ * Copyright (C) 2013, 2014 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
@@ -48,9 +48,11 @@ struct scm_port_internal
{
unsigned at_stream_start_for_bom_read : 1;
unsigned at_stream_start_for_bom_write : 1;
+ unsigned pending_eof : 1;
scm_t_port_encoding_mode encoding_mode;
scm_t_iconv_descriptors *iconv_descriptors;
- int pending_eof;
+
+ /* Key-value properties. */
SCM alist;
};
diff --git a/libguile/ports.c b/libguile/ports.c
index d8d27cc..dfab72b 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,5 +1,6 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- * 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
+ * 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ * 2014 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
@@ -259,6 +260,12 @@ scm_make_port_type (char *name,
desc->end_input = end_input_default;
desc->fill_input = fill_input;
+ /* Until Guile 2.0.10, 'setvbuf' would only work on file ports. Now
+ all port types can be supported, but it's not clear that port types
+ out in wild accept having someone else fiddle with their buffer.
+ Thus, conservatively turn it off by default. */
+ desc->setvbuf = NULL;
+
ptobnum = scm_c_port_type_add_x (desc);
/* Make a class object if GOOPS is present. */
@@ -331,6 +338,14 @@ scm_set_port_input_waiting (scm_t_bits tc, int
(*input_waiting) (SCM))
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->input_waiting = input_waiting;
}
+void
+scm_set_port_setvbuf (scm_t_bits tc, void (*setvbuf) (SCM port,
+ long read_size,
+ long write_size))
+{
+ scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->setvbuf = setvbuf;
+}
+
static void
scm_i_set_pending_eof (SCM port)
{
@@ -2329,6 +2344,105 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
/* Manipulating the buffers. */
+SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
+ (SCM port, SCM mode, SCM size),
+ "Set the buffering mode for @var{port}. @var{mode} can be:\n"
+ "@table @code\n"
+ "@item _IONBF\n"
+ "non-buffered\n"
+ "@item _IOLBF\n"
+ "line buffered\n"
+ "@item _IOFBF\n"
+ "block buffered, using a newly allocated buffer of @var{size}
bytes.\n"
+ "If @var{size} is omitted, a default size will be used.\n"
+ "@end table\n\n"
+ "Only certain types of ports are supported, most importantly\n"
+ "file ports.")
+#define FUNC_NAME s_scm_setvbuf
+{
+ int cmode;
+ long csize;
+ size_t ndrained;
+ char *drained;
+ scm_t_port *pt;
+ scm_t_ptob_descriptor *ptob;
+
+ port = SCM_COERCE_OUTPORT (port);
+
+ SCM_VALIDATE_OPENPORT (1, port);
+
+ ptob = SCM_PORT_DESCRIPTOR (port);
+ if (ptob->setvbuf == NULL)
+ scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+ "port that supports 'setvbuf'");
+
+ cmode = scm_to_int (mode);
+ if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
+ scm_out_of_range (FUNC_NAME, mode);
+
+ if (cmode == _IOLBF)
+ {
+ SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
+ cmode = _IOFBF;
+ }
+ else
+ SCM_SET_CELL_WORD_0 (port,
+ SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE);
+
+ if (SCM_UNBNDP (size))
+ {
+ if (cmode == _IOFBF)
+ csize = -1;
+ else
+ csize = 0;
+ }
+ else
+ {
+ csize = scm_to_int (size);
+ if (csize < 0 || (cmode == _IONBF && csize > 0))
+ scm_out_of_range (FUNC_NAME, size);
+ }
+
+ pt = SCM_PTAB_ENTRY (port);
+
+ if (SCM_INPUT_PORT_P (port))
+ {
+ /* Drain pending input from PORT. Don't use `scm_drain_input' since
+ it returns a string, whereas we want binary input here. */
+ ndrained = pt->read_end - pt->read_pos;
+ if (pt->read_buf == pt->putback_buf)
+ ndrained += pt->saved_read_end - pt->saved_read_pos;
+
+ if (ndrained > 0)
+ {
+ drained = scm_gc_malloc_pointerless (ndrained, "file port");
+ scm_take_from_input_buffers (port, drained, ndrained);
+ }
+ }
+ else
+ ndrained = 0;
+
+ if (SCM_OUTPUT_PORT_P (port))
+ scm_flush_unlocked (port);
+
+ if (pt->read_buf == pt->putback_buf)
+ {
+ pt->read_buf = pt->saved_read_buf;
+ pt->read_pos = pt->saved_read_pos;
+ pt->read_end = pt->saved_read_end;
+ pt->read_buf_size = pt->saved_read_buf_size;
+ }
+
+ ptob->setvbuf (port, csize, csize);
+
+ if (ndrained > 0)
+ /* Put DRAINED back to PORT. */
+ scm_unget_bytes ((unsigned char *) drained, ndrained, port);
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
/* This routine does not take any locks, as it is usually called as part
of a port implementation. */
void
diff --git a/libguile/ports.h b/libguile/ports.h
index a7fde39..7ecdd71 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -4,7 +4,8 @@
#define SCM_PORTS_H
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- * 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2006, 2008, 2009, 2010, 2011, 2012, 2013,
+ * 2014 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
@@ -200,6 +201,13 @@ typedef struct scm_t_ptob_descriptor
scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
void (*truncate) (SCM port, scm_t_off length);
+ /* When non-NULL, this is the method called by 'setvbuf' for this port.
+ It must create read and write buffers for PORT with the specified
+ sizes (a size of 0 is for unbuffered ports, which should use the
+ 'shortbuf' field.) Size -1 means to use the port's preferred buffer
+ size. */
+ void (*setvbuf) (SCM port, long read_size, long write_size);
+
unsigned flags;
} scm_t_ptob_descriptor;
@@ -238,6 +246,10 @@ SCM_API void scm_set_port_truncate (scm_t_bits tc,
void (*truncate) (SCM port,
scm_t_off length));
SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting)
(SCM));
+SCM_API void scm_set_port_setvbuf (scm_t_bits tc,
+ void (*setvbuf) (SCM port,
+ long read_size,
+ long write_size));
/* The input, output, error, and load ports. */
SCM_API SCM scm_current_input_port (void);
@@ -328,6 +340,7 @@ SCM_API SCM scm_unread_char (SCM cobj, SCM port);
SCM_API SCM scm_unread_string (SCM str, SCM port);
/* Manipulating the buffers. */
+SCM_API SCM scm_setvbuf (SCM port, SCM mode, SCM size);
SCM_API void scm_port_non_buffer (scm_t_port *pt);
SCM_API int scm_fill_input (SCM port);
SCM_API int scm_fill_input_unlocked (SCM port);
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 3d0bba5..bad4118 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
;;;; Jim Blandy <address@hidden> --- May 1999
;;;;
;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;; 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; 2011, 2012, 2013, 2014 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
@@ -1468,6 +1468,18 @@
(with-test-prefix "setvbuf"
+ (pass-if-exception "closed port"
+ exception:wrong-type-arg
+ (let ((port (open-input-file "/dev/null")))
+ (close-port port)
+ (setvbuf port _IOFBF)))
+
+ (pass-if-exception "string port"
+ exception:wrong-type-arg
+ (let ((port (open-input-string "Hey!")))
+ (close-port port)
+ (setvbuf port _IOFBF)))
+
(pass-if "line/column number preserved"
;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
;; line and/or column number.
--
1.7.5.4
>From 6a3feb79b289410a62d2e0c8a70e0ea59d0cf8cd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Tue, 21 Jan 2014 02:28:35 -0500
Subject: [PATCH 2/2] Custom binary input ports support 'setvbuf'.
Modified-by: Mark H Weaver <address@hidden>
* libguile/r6rs-ports.c (CBIP_BUFFER_SIZE): Adjust comment. Set to 8KiB.
(SCM_SET_CBIP_BYTEVECTOR): New macro.
(cbip_setvbuf): New function.
(cbip_fill_input): Check whether PORT is buffered. When unbuffered,
check whether BV can hold C_REQUESTED bytes, and allocate a new
bytevector if not; copy the data back from BV to c_port->read_pos.
Remove 'again' label, and don't loop there.
(initialize_custom_binary_input_ports): Set PTOB's 'setvbuf' method.
* test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["custom binary
input port unbuffered & 'port-position'", "custom binary input port
unbuffered & 'read!' calls", "custom binary input port, unbuffered
then buffered", "custom binary input port, buffered then unbuffered"]:
New tests.
* doc/ref/api-io.texi (R6RS Binary Input): Document the buffering of
custom binary input ports, and link to 'setvbuf'.
---
doc/ref/api-io.texi | 4 +
libguile/r6rs-ports.c | 89 +++++++++++++++++++++++-----
test-suite/tests/r6rs-ports.test | 123 ++++++++++++++++++++++++++++++++++++++
3 files changed, 201 insertions(+), 15 deletions(-)
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index edf38be..49e2a05 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1792,6 +1792,10 @@ indicating the position of the next byte is to read.
Finally, if @var{close} is not @code{#f}, it must be a thunk. It is
invoked when the custom binary input port is closed.
+The returned port is fully buffered by default, but its buffering mode
+can be changed using @code{setvbuf} (@pxref{Ports and File Descriptors,
address@hidden).
+
Using a custom binary input port, the @code{open-bytevector-input-port}
procedure could be implemented as follows:
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index a8fc3f1..5b8da1d 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -272,18 +272,59 @@ cbp_close (SCM port)
static scm_t_bits custom_binary_input_port_type = 0;
-/* Size of the buffer embedded in custom binary input ports. */
-#define CBIP_BUFFER_SIZE 4096
+/* Initial size of the buffer embedded in custom binary input ports. */
+#define CBIP_BUFFER_SIZE 8192
/* Return the bytevector associated with PORT. */
#define SCM_CBIP_BYTEVECTOR(_port) \
SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4)
+/* Set BV as the bytevector associated with PORT. */
+#define SCM_SET_CBIP_BYTEVECTOR(_port, _bv) \
+ SCM_SIMPLE_VECTOR_SET (SCM_PACK (SCM_STREAM (_port)), 4, (_bv))
+
/* Return the various procedures of PORT. */
#define SCM_CBIP_READ_PROC(_port) \
SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+/* Set PORT's internal buffer according to READ_SIZE. */
+static void
+cbip_setvbuf (SCM port, long read_size, long write_size)
+{
+ SCM bv;
+ scm_t_port *pt;
+
+ pt = SCM_PTAB_ENTRY (port);
+ bv = SCM_CBIP_BYTEVECTOR (port);
+
+ switch (read_size)
+ {
+ case 0:
+ /* Unbuffered: keep PORT's bytevector as is (it will be used in
+ future 'scm_c_read' calls), but point to the one-byte buffer. */
+ pt->read_buf = &pt->shortbuf;
+ pt->read_buf_size = 1;
+ break;
+
+ case -1:
+ /* Preferred size: keep the current bytevector and use it as the
+ backing store. */
+ pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ pt->read_buf_size = SCM_BYTEVECTOR_LENGTH (bv);
+ break;
+
+ default:
+ /* Fully buffered: allocate a buffer of READ_SIZE bytes. */
+ bv = scm_c_make_bytevector (read_size);
+ SCM_SET_CBIP_BYTEVECTOR (port, bv);
+ pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ pt->read_buf_size = read_size;
+ }
+
+ pt->read_pos = pt->read_end = pt->read_buf;
+}
+
static inline SCM
make_cbip (SCM read_proc, SCM get_position_proc,
SCM set_position_proc, SCM close_proc)
@@ -330,26 +371,39 @@ cbip_fill_input (SCM port)
int result;
scm_t_port *c_port = SCM_PTAB_ENTRY (port);
- again:
if (c_port->read_pos >= c_port->read_end)
{
/* Invoke the user's `read!' procedure. */
+ int buffered;
size_t c_octets, c_requested;
SCM bv, read_proc, octets;
c_requested = c_port->read_buf_size;
+ read_proc = SCM_CBIP_READ_PROC (port);
- /* Use the bytevector associated with PORT as the buffer passed to the
- `read!' procedure, thereby avoiding additional allocations. */
bv = SCM_CBIP_BYTEVECTOR (port);
- read_proc = SCM_CBIP_READ_PROC (port);
+ buffered =
+ (c_port->read_buf == (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
- /* The assumption here is that C_PORT's internal buffer wasn't changed
- behind our back. */
- assert (c_port->read_buf ==
- (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
- assert ((unsigned) c_port->read_buf_size
- == SCM_BYTEVECTOR_LENGTH (bv));
+ if (buffered)
+ /* Make sure the buffer isn't corrupt. BV can be passed directly
+ to READ_PROC. */
+ assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv));
+ else
+ {
+ /* This is an unbuffered port. When called via the
+ 'get-bytevector-*' procedures, and thus via 'scm_c_read', we
+ are passed the caller-provided buffer, so we need to check its
+ size. */
+ if (SCM_BYTEVECTOR_LENGTH (bv) < c_requested)
+ {
+ /* Bad luck: we have to make another allocation. Save that
+ bytevector for later reuse, in the hope that the application
+ has regular access patterns. */
+ bv = scm_c_make_bytevector (c_requested);
+ SCM_SET_CBIP_BYTEVECTOR (port, bv);
+ }
+ }
octets = scm_call_3 (read_proc, bv, SCM_INUM0,
scm_from_size_t (c_requested));
@@ -357,11 +411,15 @@ cbip_fill_input (SCM port)
if (SCM_UNLIKELY (c_octets > c_requested))
scm_out_of_range (FUNC_NAME, octets);
- c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ if (!buffered)
+ /* Copy the data back to the internal buffer. */
+ memcpy ((char *) c_port->read_pos, SCM_BYTEVECTOR_CONTENTS (bv),
+ c_octets);
+
c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
- if (c_octets > 0)
- goto again;
+ if (c_octets != 0 || c_requested == 0)
+ result = (int) *c_port->read_pos;
else
result = EOF;
}
@@ -410,6 +468,7 @@ initialize_custom_binary_input_ports (void)
scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
scm_set_port_close (custom_binary_input_port_type, cbp_close);
+ scm_set_port_setvbuf (custom_binary_input_port_type, cbip_setvbuf);
}
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 4bd8a70..339679f 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -456,6 +456,129 @@ not `set-port-position!'"
(u8-list->bytevector
(map char->integer (string->list "Port!")))))))
+ (pass-if-equal "custom binary input port unbuffered & 'port-position'"
+ '(0 2 5 11)
+ ;; Check that the value returned by 'port-position' is correct, and
+ ;; that each 'port-position' call leads one call to the
+ ;; 'get-position' method.
+ (let* ((str "Hello Port!")
+ (output (make-bytevector (string-length str)))
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (read! (lambda (bv start count)
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (pos '())
+ (get-pos (lambda ()
+ (let ((p (port-position source)))
+ (set! pos (cons p pos))
+ p)))
+ (port (make-custom-binary-input-port "the port" read!
+ get-pos #f #f)))
+ (setvbuf port _IONBF)
+ (and (= 0 (port-position port))
+ (begin
+ (get-bytevector-n! port output 0 2)
+ (= 2 (port-position port)))
+ (begin
+ (get-bytevector-n! port output 2 3)
+ (= 5 (port-position port)))
+ (let ((bv (string->utf8 (get-string-all port))))
+ (bytevector-copy! bv 0 output 5 (bytevector-length bv))
+ (= (string-length str) (port-position port)))
+ (bytevector=? output (string->utf8 str))
+ (reverse pos))))
+
+ (pass-if-equal "custom binary input port unbuffered & 'read!' calls"
+ `((2 "He") (3 "llo") (42 " Port!"))
+ (let* ((str "Hello Port!")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IONBF)
+ (let ((ret (list (get-bytevector-n port 2)
+ (get-bytevector-n port 3)
+ (get-bytevector-n port 42))))
+ (zip (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
+ (pass-if-equal "custom binary input port, unbuffered then buffered"
+ `((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consectetur…")
+ (777 ,(eof-object)))
+ (let* ((str "Lorem ipsum dolor sit amet, consectetur…")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IONBF)
+ (let ((ret (list (get-bytevector-n port 6)
+ (get-bytevector-n port 12)
+ (begin
+ (setvbuf port _IOFBF 777)
+ (get-bytevector-n port 42))
+ (get-bytevector-n port 42))))
+ (zip (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
+ (pass-if-equal "custom binary input port, buffered then unbuffered"
+ `((18
+ 42 14 ; scm_c_read tries to fill the 42-byte buffer
+ 42)
+ ("Lorem " "ipsum dolor " "sit amet, consectetur bla…" ,(eof-object)))
+ (let* ((str "Lorem ipsum dolor sit amet, consectetur bla…")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IOFBF 18)
+ (let ((ret (list (get-bytevector-n port 6)
+ (get-bytevector-n port 12)
+ (begin
+ (setvbuf port _IONBF)
+ (get-bytevector-n port 42))
+ (get-bytevector-n port 42))))
+ (list (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
(pass-if "custom binary input port `close-proc' is called"
(let* ((closed? #f)
(read! (lambda (bv start count) 0))
--
1.7.5.4
- Making custom binary input ports unbuffered, Ludovic Courtès, 2014/01/14
- Re: Making custom binary input ports unbuffered, Mark H Weaver, 2014/01/15
- Re: Making custom binary input ports unbuffered, Ludovic Courtès, 2014/01/15
- Re: Making custom binary input ports unbuffered, Ludovic Courtès, 2014/01/15
- Re: Making custom binary input ports unbuffered, Mark H Weaver, 2014/01/15
- Re: Making custom binary input ports unbuffered, Ludovic Courtès, 2014/01/16
- Re: Making custom binary input ports unbuffered, Ludovic Courtès, 2014/01/18
- Re: Making custom binary input ports unbuffered,
Mark H Weaver <=
- Re: Making custom binary input ports unbuffered, Ludovic Courtès, 2014/01/21
- Re: Making custom binary input ports unbuffered, Mark H Weaver, 2014/01/21
- Re: Making custom binary input ports unbuffered, Ludovic Courtès, 2014/01/21