Hello,
This is a followup to these threads:
http://thread.gmane.org/gmane.lisp.guile.devel/6549
http://thread.gmane.org/gmane.lisp.guile.devel/7155 (to a lesser extent)
The attached patch aims to allow an `scm_c_read ()' call for N bytes to
translate into a `read(2)' for N bytes in the case of unbuffered file
ports (such as sockets); it also allows the port's buffer to be bypassed
when more data is requested than can fit in the buffer.
The first patch adds a `read' method to ports, which should read up to N
bytes into a caller-supplied buffer. It is meant as a replacement for
`fill_input', which fills in the port's buffer regardless of the
application request, that is, reads a single byte in the case of
unbuffered ports.
The change is ABI-compatible since:
1. `scm_t_ptob_descriptor's are always allocated by libguile code, not
by the application code, so changing its size doesn't break the
ABI;
2. Apart from the added `read' field, the layout of
`scm_t_ptob_descriptor' is unchanged, so inlines and macros that
refer to it still work;
3. `fill_input' is still honored when provided.
Subsequent patches make use of `scm_set_port_read ()' in file and string
ports, change `uniform-vector-read!' to use `scm_c_read ()', and add a
benchmark for this. The benchmark shows that `uniform-vector-read!' is
around 3 orders of magnitude (!) faster on unbuffered file ports with
the new method.
OK to commit to 1.8 and master?
Thanks,
Ludovic.
>From 3f9bae2580bca420b20d31e1074a2bab19aa3c09 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[EMAIL PROTECTED]>
Date: Sat, 31 May 2008 22:24:45 +0200
Subject: [PATCH] Add `scm_set_port_read ()'.
---
libguile/ports.c | 120 +++++++++++++++++++++++++++++++++++++++++++++---------
libguile/ports.h | 5 ++-
2 files changed, 104 insertions(+), 21 deletions(-)
diff --git a/libguile/ports.c b/libguile/ports.c
index b25a7d0..f887ec9 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -83,6 +83,10 @@
#define HAVE_FTRUNCATE 1
#endif
+#ifndef SCM_MIN
+# define SCM_MIN(A, B) ((A) < (B) ? (A) : (B))
+#endif
+
/* The port kind table --- a dynamically resized array of port types. */
@@ -162,6 +166,8 @@ scm_make_port_type (char *name,
scm_ptobs[scm_numptob].seek = 0;
scm_ptobs[scm_numptob].truncate = 0;
+ scm_ptobs[scm_numptob].read = NULL;
+
scm_numptob++;
}
SCM_CRITICAL_SECTION_END;
@@ -177,6 +183,15 @@ scm_make_port_type (char *name,
}
void
+scm_set_port_read (scm_t_bits tc,
+ size_t (* read) (SCM, void *, size_t))
+{
+ /* The provided `read' method overrides `fill_input'. */
+ scm_ptobs[SCM_TC2PTOBNUM (tc)].fill_input = NULL;
+ scm_ptobs[SCM_TC2PTOBNUM (tc)].read = read;
+}
+
+void
scm_set_port_mark (scm_t_bits tc, SCM (*mark) (SCM))
{
scm_ptobs[SCM_TC2PTOBNUM (tc)].mark = mark;
@@ -946,6 +961,7 @@ int
scm_fill_input (SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ const scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (pt->read_buf == pt->putback_buf)
{
@@ -957,7 +973,23 @@ scm_fill_input (SCM port)
if (pt->read_pos < pt->read_end)
return *(pt->read_pos);
}
- return scm_ptobs[SCM_PTOBNUM (port)].fill_input (port);
+
+ if (ptob->fill_input != NULL)
+ /* Kept for backward compatibility. */
+ return ptob->fill_input (port);
+ else
+ {
+ size_t count;
+
+ count = ptob->read (port, pt->read_buf, pt->read_buf_size);
+ pt->read_pos = pt->read_buf;
+ pt->read_end = pt->read_buf + count;
+
+ if (count == 0)
+ return EOF;
+ else
+ return (int) *pt->read_buf;
+ }
}
@@ -1015,45 +1047,93 @@ scm_c_read (SCM port, void *buffer, size_t size)
{
scm_t_port *pt;
size_t n_read = 0, n_available;
+ const scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
SCM_VALIDATE_OPINPORT (1, port);
pt = SCM_PTAB_ENTRY (port);
+ ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (pt->rw_active == SCM_PORT_WRITE)
- scm_ptobs[SCM_PTOBNUM (port)].flush (port);
+ ptob->flush (port);
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
if (SCM_READ_BUFFER_EMPTY_P (pt))
{
- if (scm_fill_input (port) == EOF)
- return 0;
+ if ((ptob->fill_input != NULL) || (size <= pt->read_buf_size))
+ {
+ /* Fill in PORT's buffer. */
+ if (scm_fill_input (port) == EOF)
+ return 0;
+ }
+ else
+ /* Read directly into BUFFER, bypassing PORT's own buffer. */
+ return (ptob->read (port, buffer, size));
}
-
+
n_available = pt->read_end - pt->read_pos;
-
- while (n_available < size)
+
+ if (ptob->fill_input == NULL)
{
- memcpy (buffer, pt->read_pos, n_available);
- buffer = (char *) buffer + n_available;
- pt->read_pos += n_available;
- n_read += n_available;
-
- if (SCM_READ_BUFFER_EMPTY_P (pt))
+ /* Use PTOB's `read' method. */
+ size_t count;
+
+ count = SCM_MIN (n_available, size);
+ memcpy (buffer, pt->read_pos, count);
+ pt->read_pos += count;
+ n_read += count;
+
+ if (n_read < size)
{
- if (scm_fill_input (port) == EOF)
- return n_read;
+ /* PORT's buffer is now empty but we haven't yet read SIZE
+ bytes. */
+ size_t remaining = size - n_read;
+
+ pt->read_pos = pt->read_end = pt->read_buf;
+
+ if (remaining >= pt->read_buf_size)
+ /* Read directly into BUFFER. */
+ n_read += ptob->read (port, buffer + n_read, remaining);
+ else
+ {
+ /* The remaining size is less than PORT's buffer size. */
+ count = ptob->read (port, pt->read_buf, pt->read_buf_size);
+ pt->read_end += count;
+
+ memcpy (buffer + n_read, pt->read_buf, SCM_MIN (remaining, count));
+ pt->read_pos += SCM_MIN (remaining, count);
+ n_read += SCM_MIN (remaining, count);
+ }
}
- size -= n_available;
- n_available = pt->read_end - pt->read_pos;
+ return n_read;
}
+ else
+ {
+ /* For backward compatibility: use the `fill_input' method. */
+ while (n_available < size)
+ {
+ memcpy (buffer, pt->read_pos, n_available);
+ buffer = (char *) buffer + n_available;
+ pt->read_pos += n_available;
+ n_read += n_available;
+
+ if (SCM_READ_BUFFER_EMPTY_P (pt))
+ {
+ if (scm_fill_input (port) == EOF)
+ return n_read;
+ }
+
+ size -= n_available;
+ n_available = pt->read_end - pt->read_pos;
+ }
- memcpy (buffer, pt->read_pos, size);
- pt->read_pos += size;
+ memcpy (buffer, pt->read_pos, size);
+ pt->read_pos += size;
- return n_read + size;
+ return n_read + size;
+ }
}
#undef FUNC_NAME
diff --git a/libguile/ports.h b/libguile/ports.h
index 084a555..17bbe09 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -178,12 +178,13 @@ typedef struct scm_t_ptob_descriptor
void (*flush) (SCM port);
void (*end_input) (SCM port, int offset);
- int (*fill_input) (SCM port);
+ int (*fill_input) (SCM port); /* deprecated: use `read' instead */
int (*input_waiting) (SCM port);
off_t (*seek) (SCM port, off_t OFFSET, int WHENCE);
void (*truncate) (SCM port, off_t length);
+ size_t (*read) (SCM port, void *data, size_t size);
} scm_t_ptob_descriptor;
#define SCM_TC2PTOBNUM(x) (0x0ff & ((x) >> 8))
@@ -205,6 +206,8 @@ SCM_API scm_t_bits scm_make_port_type (char *name,
void (*write) (SCM port,
const void *data,
size_t size));
+SCM_API void scm_set_port_read (scm_t_bits tc,
+ size_t (* read) (SCM, void *, size_t));
SCM_API void scm_set_port_mark (scm_t_bits tc, SCM (*mark) (SCM));
SCM_API void scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM));
SCM_API void scm_set_port_print (scm_t_bits tc,
--
1.5.5
>From 406d36e849d2d88452f816e2325c5607250b28dc Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[EMAIL PROTECTED]>
Date: Sat, 31 May 2008 22:26:29 +0200
Subject: [PATCH] Use `scm_set_port_read ()' in file ports.
---
libguile/fports.c | 23 ++++++++---------------
1 files changed, 8 insertions(+), 15 deletions(-)
diff --git a/libguile/fports.c b/libguile/fports.c
index efbd278..1208836 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -582,29 +582,21 @@ fport_wait_for_input (SCM port)
static void fport_flush (SCM port);
-/* fill a port's read-buffer with a single read. returns the first
- char or EOF if end of file. */
-static int
-fport_fill_input (SCM port)
+/* Read up to SIZE bytes from PORT into BUFFER. */
+static size_t
+fport_read (SCM port, void *buffer, size_t size)
{
long count;
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
scm_t_fport *fp = SCM_FSTREAM (port);
#ifndef __MINGW32__
fport_wait_for_input (port);
#endif /* !__MINGW32__ */
- SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size));
+ SCM_SYSCALL (count = read (fp->fdes, buffer, size));
if (count == -1)
scm_syserror ("fport_fill_input");
- if (count == 0)
- return EOF;
- else
- {
- pt->read_pos = pt->read_buf;
- pt->read_end = pt->read_buf + count;
- return *pt->read_buf;
- }
+
+ return (size_t) count;
}
static off_t_or_off64_t
@@ -906,8 +898,9 @@ fport_free (SCM port)
static scm_t_bits
scm_make_fptob ()
{
- scm_t_bits tc = scm_make_port_type ("file", fport_fill_input, fport_write);
+ scm_t_bits tc = scm_make_port_type ("file", NULL, fport_write);
+ scm_set_port_read (tc, fport_read);
scm_set_port_free (tc, fport_free);
scm_set_port_print (tc, fport_print);
scm_set_port_flush (tc, fport_flush);
--
1.5.5
>From a4e465c07d450566115f43844a042e127cb0eeea Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[EMAIL PROTECTED]>
Date: Sat, 31 May 2008 22:27:46 +0200
Subject: [PATCH] Use `scm_c_read ()' in `uniform-vector-read!'.
---
libguile/srfi-4.c | 61 ++++++++++++++++++++---------------------------------
1 files changed, 23 insertions(+), 38 deletions(-)
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 7d22f8b..5bcdcd5 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -1,6 +1,6 @@
/* srfi-4.c --- Uniform numeric vector datatypes.
*
- * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2006, 2008 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
@@ -824,6 +824,17 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
}
#undef FUNC_NAME
+/* Release the array handle pointed to by ARG. */
+static void
+release_array (void *arg)
+{
+ scm_t_array_handle *handle;
+
+ handle = (scm_t_array_handle *) arg;
+ scm_array_handle_release (handle);
+}
+
+
SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
(SCM uvec, SCM port_or_fd, SCM start, SCM end),
"Fill the elements of @var{uvec} by reading\n"
@@ -846,7 +857,7 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
#define FUNC_NAME s_scm_uniform_vector_read_x
{
scm_t_array_handle handle;
- size_t vlen, sz, ans;
+ size_t vlen, sz, ans, bytes_read;
ssize_t inc;
size_t cstart, cend;
size_t remaining, off;
@@ -886,52 +897,26 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
if (SCM_NIMP (port_or_fd))
{
- scm_t_port *pt = SCM_PTAB_ENTRY (port_or_fd);
+ scm_dynwind_begin (0);
+ scm_dynwind_unwind_handler (release_array, &handle, 0);
- if (pt->rw_active == SCM_PORT_WRITE)
- scm_flush (port_or_fd);
+ bytes_read = scm_c_read (port_or_fd, base + off, remaining);
- ans = cend - cstart;
- while (remaining > 0)
- {
- if (pt->read_pos < pt->read_end)
- {
- size_t to_copy = min (pt->read_end - pt->read_pos,
- remaining);
-
- memcpy (base + off, pt->read_pos, to_copy);
- pt->read_pos += to_copy;
- remaining -= to_copy;
- off += to_copy;
- }
- else
- {
- if (scm_fill_input (port_or_fd) == EOF)
- {
- if (remaining % sz != 0)
- SCM_MISC_ERROR ("unexpected EOF", SCM_EOL);
- ans -= remaining / sz;
- break;
- }
- }
- }
-
- if (pt->rw_random)
- pt->rw_active = SCM_PORT_READ;
+ scm_dynwind_end ();
}
else /* file descriptor. */
{
int fd = scm_to_int (port_or_fd);
- int n;
- SCM_SYSCALL (n = read (fd, base + off, remaining));
- if (n == -1)
+ SCM_SYSCALL (bytes_read = read (fd, base + off, remaining));
+ if (bytes_read == -1)
SCM_SYSERROR;
- if (n % sz != 0)
- SCM_MISC_ERROR ("unexpected EOF", SCM_EOL);
- ans = n / sz;
}
+ if (bytes_read % sz != 0)
+ SCM_MISC_ERROR ("unexpected EOF", SCM_EOL);
+ ans = bytes_read / sz;
+
scm_array_handle_release (&handle);
return scm_from_size_t (ans);
--
1.5.5
>From 9ff77d3b9fe8384841743c4e7a3ef5b33d9a83b5 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[EMAIL PROTECTED]>
Date: Sun, 1 Jun 2008 19:21:35 +0200
Subject: [PATCH] Use `scm_set_port_read ()' in string ports.
---
libguile/strports.c | 27 ++++++++++++++++++---------
1 files changed, 18 insertions(+), 9 deletions(-)
diff --git a/libguile/strports.c b/libguile/strports.c
index 8659ccf..f6fb24b 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2008 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,10 @@
#include <string.h>
#endif
+#ifndef SCM_MIN
+# define SCM_MIN(A, B) ((A) < (B) ? (A) : (B))
+#endif
+
/* {Ports - string ports}
@@ -93,15 +97,19 @@
scm_t_bits scm_tc16_strport;
-static int
-stfill_buffer (SCM port)
+/* Read up to SIZE bytes from PORT into BUFFER. */
+static size_t
+st_read (SCM port, void *buffer, size_t size)
{
+ size_t available, count;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (pt->read_pos >= pt->read_end)
- return EOF;
- else
- return scm_return_first_int (*pt->read_pos, port);
+
+ available = pt->read_end - pt->read_pos;
+ count = SCM_MIN (available, size);
+
+ memcpy (buffer, pt->read_pos, count);
+
+ return count;
}
/* change the size of a port's string to new_size. this doesn't
@@ -538,8 +546,9 @@ scm_eval_string (SCM string)
static scm_t_bits
scm_make_stptob ()
{
- scm_t_bits tc = scm_make_port_type ("string", stfill_buffer, st_write);
+ scm_t_bits tc = scm_make_port_type ("string", NULL, st_write);
+ scm_set_port_read (tc, st_read);
scm_set_port_mark (tc, scm_markstream);
scm_set_port_end_input (tc, st_end_input);
scm_set_port_flush (tc, st_flush);
--
1.5.5
>From a627bb3639d2a1cffccddf55de679c129ee0cda1 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[EMAIL PROTECTED]>
Date: Sun, 1 Jun 2008 19:31:36 +0200
Subject: [PATCH] Add `uniform-vector-read!' benchmark.
---
benchmark-suite/Makefile.am | 11 ++--
benchmark-suite/benchmarks/uniform-vector-read.bm | 53 +++++++++++++++++++++
2 files changed, 59 insertions(+), 5 deletions(-)
create mode 100644 benchmark-suite/benchmarks/uniform-vector-read.bm
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index a8f4719..3993faf 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -1,7 +1,8 @@
-SCM_BENCHMARKS = benchmarks/0-reference.bm \
- benchmarks/continuations.bm \
- benchmarks/if.bm \
- benchmarks/logand.bm \
- benchmarks/read.bm
+SCM_BENCHMARKS = benchmarks/0-reference.bm \
+ benchmarks/continuations.bm \
+ benchmarks/if.bm \
+ benchmarks/logand.bm \
+ benchmarks/read.bm \
+ benchmarks/uniform-vector-read.bm
EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS)
diff --git a/benchmark-suite/benchmarks/uniform-vector-read.bm b/benchmark-suite/benchmarks/uniform-vector-read.bm
new file mode 100644
index 0000000..d288f0b
--- /dev/null
+++ b/benchmark-suite/benchmarks/uniform-vector-read.bm
@@ -0,0 +1,53 @@
+;;; uniform-vector-read.bm --- Exercise binary I/O primitives. -*- Scheme -*-
+;;;
+;;; Copyright (C) 2008 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this software; see the file COPYING. If not, write to
+;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;; Boston, MA 02110-1301 USA
+
+(define-module (benchmarks uniform-vector-read)
+ :use-module (benchmark-suite lib)
+ :use-module (srfi srfi-4))
+
+(define file-name
+ (tmpnam))
+
+(define %buffer-size
+ 7777)
+
+(define buf
+ (make-u8vector %buffer-size))
+
+(define str
+ (make-string %buffer-size))
+
+
+(with-benchmark-prefix "uniform-vector-read!"
+
+ (benchmark "uniform-vector-write" 500
+ (let ((output (open-output-file file-name)))
+ (uniform-vector-write buf output)
+ (close output)))
+
+ (benchmark "uniform-vector-read!" 500
+ (let ((input (open-input-file file-name)))
+ (setvbuf input _IONBF)
+ (uniform-vector-read! buf input)
+ (close input)))
+
+ (benchmark "string port" 5000
+ (let ((input (open-input-string str)))
+ (uniform-vector-read! buf input)
+ (close input))))
--
1.5.5
