[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 18/18: Generic port facility provides buffering uniforml
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 18/18: Generic port facility provides buffering uniformly |
|
Date: |
Wed, 06 Apr 2016 17:27:08 +0000 |
wingo pushed a commit to branch wip-port-refactor
in repository guile.
commit 8399e7af51df3956417e8776ac506e04f4c3bdce
Author: Andy Wingo <address@hidden>
Date: Wed Apr 6 09:21:44 2016 +0200
Generic port facility provides buffering uniformly
* libguile/ports.h (struct scm_t_port_buffer): New data type.
(struct scm_t_port): Refactor to use port buffers instead of
implementation-managed read and write pointers. Add "read_buffering"
member.
(SCM_INITIAL_PUTBACK_BUF_SIZE, SCM_READ_BUFFER_EMPTY_P): Remove.
(scm_t_ptob_descriptor): Rename "fill_input" function to "read", and
take a port buffer, returning void. Likewise "write" takes a port
buffer and returns void. Remove "end_input"; instead if there is
buffered input and rw_random is true, then there must be a seek
function, so just seek back if needed. Remove "flush"; instead all
calls to the "write" function implicitly include a "flush", since the
buffering happens in the generic port code now. Remove "setvbuf", but
add "get_natural_buffer_sizes"; instead the generic port code can
buffer any port.
(scm_make_port_type): Adapt to read and write prototype changes.
(scm_set_port_flush, scm_set_port_end_input, scm_set_port_setvbuf):
Remove.
(scm_slow_get_byte_or_eof_unlocked)
(scm_slow_get_peek_or_eof_unlocked): Remove; the slow path is to call
scm_fill_input.
(scm_set_port_get_natural_buffer_sizes): New function.
(scm_c_make_port_buffer): New internal function.
(scm_port_non_buffer): Remove. This was a function for
implementations that is no longer needed. Instead open with BUF0 or
use (setvbuf port 'none).
(scm_fill_input, scm_fill_input_unlocked): Return the filled port
buffer.
(scm_get_byte_or_eof_unlocked, scm_peek_byte_or_eof_unlocked): Adapt
to changes in buffering and EOF management.
* libguile/ports.c: Adapt to port interface changes.
(initialize_port_buffers): New function, using the port mode flags to
set up appropriate initial buffering for all ports.
(scm_c_make_port_with_encoding): Create port buffers here instead of
delegating to implementations.
(scm_close_port): Flush the port if needed instead of delegating to
the implementation.
* libguile/filesys.c (set_element): Adapt to buffering changes.
* libguile/fports.c (fport_get_natural_buffer_sizes): New function,
replacing scm_fport_buffer_add.
(fport_write, fport_read): Update to let the generic ports code do the
buffering.
(fport_flush, fport_end_input): Remove.
(fport_close): Don't flush in a dynwind; that's the core ports' job.
(scm_make_fptob): Adapt.
* libguile/ioext.c (scm_redirect_port): Adapt to buffering changes.
* libguile/poll.c (scm_primitive_poll): Adapt to buffering changes.
* libguile/ports-internal.h (struct scm_port_internal): Remove
pending_eof flag; this is now set on the read buffer.
* libguile/r6rs-ports.c (struct bytevector_input_port): New type. The
new buffering arrangement means that there's now an intermediate
buffer between the bytevector and the user of the port; this could
lead to a perf degradation, but on the other hand there are some other
speedups enabled by the buffering refactor, so probably the memcpy
cost is dwarfed by the cost of the other parts of the ports
machinery.
(make_bytevector_input_port, bytevector_input_port_read):
(bytevector_input_port_seek, initialize_bytevector_input_ports): Adapt
to new buffering arrangement.
(struct custom_binary_port): Remove read buffer, as Guile handles that
now.
(custom_binary_input_port_setvbuf): Remove; now handled by Guile.
(make_custom_binary_input_port, custom_binary_input_port_read)
(initialize_custom_binary_input_ports): Adapt.
(scm_get_bytevector_some): Adapt to new EOF management.
(scm_t_bytevector_output_port_buffer): Hold on to the underlying port,
so we can flush it if it's open.
(make_bytevector_output_port, bytevector_output_port_write):
(bytevector_output_port_seek): Adapt.
(bytevector_output_port_procedure): Flush the port as appropriate, so
that we get all the bytes.
(make_custom_binary_output_port, custom_binary_output_port_write):
Adapt.
(make_transcoded_port): Don't muck with buffering.
(transcoded_port_write): Simply forward the write to the underlying
port.
(transcoded_port_read): Likewise.
(transcoded_port_close): No need to flush.
(initialize_transcoded_ports): Adapt.
* libguile/read.c (scm_i_scan_for_encoding): Adapt to buffering
changes.
* libguile/rw.c (scm_write_string_partial): Adapt to buffering changes.
* libguile/strports.c: Adapt to the fact that we don't manage the
buffer. Probably room for speed improvements here...
* libguile/vports.c (soft_port_get_natural_buffer_sizes): New function.
Adapt the rest of the file for the new buffering regime.
* test-suite/tests/r6rs-ports.test ("8.2.10 Output ports"): Custom
binary output ports need to be flushed before you can rely on the
write! procedure having been called. Add necessary flush-port
invocations.
("8.2.6 Input and output ports"): Transcoded ports now have an
internal buffer by default. This test checks that the characters are
transcoded one at a time, so to do that, call setvbuf on the
transcoded port to remove the buffer.
* test-suite/tests/web-client.test (run-with-http-transcript): Fix for
different flushing regime on soft ports. (The vestigial flush
procedure is now called after each write, which is not what the test
was expecting.)
* test-suite/standalone/test-scm-c-read.c: Update for changes to the C
interface for defining port types.
* doc/ref/api-io.texi (Ports): Update to discuss buffering in a generic
way, and to remove a hand-wavey paragraph describing string ports as
"interesting and powerful".
(Reading, Writing): Remove placeholder comments. Document
`scm_lfwrite'.
(Buffering): New section.
(File Ports): Link to buffering.
(I/O Extensions): Join subnodes into parent and describe new API,
including buffering API.
* doc/ref/posix.texi (Ports and File Descriptors): Link to buffering.
Remove unread-char etc, as they are documented elsewhere.
(Pipes, Network Sockets and Communication): Link to buffering.
---
doc/ref/api-io.texi | 426 +++++++++---------
doc/ref/posix.texi | 69 ++--
libguile/filesys.c | 4 +-
libguile/fports.c | 244 ++---------
libguile/ioext.c | 24 +-
libguile/poll.c | 8 +-
libguile/ports-internal.h | 1 -
libguile/ports.c | 728 +++++++++++++------------------
libguile/ports.h | 218 +++++-----
libguile/r6rs-ports.c | 495 ++++++---------------
libguile/read.c | 12 +-
libguile/rw.c | 19 +-
libguile/strports.c | 275 ++++--------
libguile/vports.c | 103 ++---
test-suite/standalone/test-scm-c-read.c | 59 +--
test-suite/tests/r6rs-ports.test | 3 +
test-suite/tests/web-client.test | 12 +-
17 files changed, 1052 insertions(+), 1648 deletions(-)
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 4e4d59b..b5e70cf 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -12,13 +12,14 @@
* Reading:: Procedures for reading from a port.
* Writing:: Procedures for writing to a port.
* Closing:: Procedures to close a port.
+* Buffering:: Controlling when data is written to ports.
* Random Access:: Moving around a random access port.
* Line/Delimited:: Read and write lines or delimited text.
* Block Reading and Writing:: Reading and writing blocks of text.
* Default Ports:: Defaults for input, output and errors.
* Port Types:: Types of port and how to make them.
* R6RS I/O Ports:: The R6RS port API.
-* I/O Extensions:: Using and extending ports in C.
+* I/O Extensions:: Implementing new port types in C.
* BOM Handling:: Handling of Unicode byte order marks.
@end menu
@@ -32,26 +33,21 @@ Sequential input/output in Scheme is represented by
operations on a
for working with ports.
Ports are created by opening, for instance @code{open-file} for a file
-(@pxref{File Ports}). Characters can be read from an input port and
-written to an output port, or both on an input/output port. A port
-can be closed (@pxref{Closing}) when no longer required, after which
-any attempt to read or write is an error.
-
-The formal definition of a port is very generic: an input port is
-simply ``an object which can deliver characters on demand,'' and an
-output port is ``an object which can accept characters.'' Because
-this definition is so loose, it is easy to write functions that
-simulate ports in software. @dfn{Soft ports} and @dfn{string ports}
-are two interesting and powerful examples of this technique.
-(@pxref{Soft Ports}, and @ref{String Ports}.)
+(@pxref{File Ports}). Other kinds of ports include @dfn{soft ports} and
address@hidden ports} (@pxref{Soft Ports}, and @ref{String Ports}).
+Characters or bytes can be read from an input port and written to an
+output port, or both on an input/output port. A port can be closed
+(@pxref{Closing}) when no longer required, after which any attempt to
+read or write is an error.
Ports are garbage collected in the usual way (@pxref{Memory
-Management}), and will be closed at that time if not already closed.
-In this case any errors occurring in the close will not be reported.
-Usually a program will want to explicitly close so as to be sure all
-its operations have been successful. Of course if a program has
-abandoned something due to an error or other condition then closing
-problems are probably not of interest.
+Management}), and will be closed at that time if not already closed. In
+this case any errors occurring in the close will not be reported.
+Usually a program will want to explicitly close so as to be sure all its
+operations have been successful, including any buffered writes
+(@pxref{Buffering}). Of course if a program has abandoned something due
+to an error or other condition then closing problems are probably not of
+interest.
It is strongly recommended that file ports be closed explicitly when
no longer required. Most systems have limits on how many files can be
@@ -71,10 +67,10 @@ available, so files bigger than 2 Gbytes (@math{2^31}
bytes) can be
read and written on a 32-bit system.
Each port has an associated character encoding that controls how bytes
-read from the port are converted to characters and string and controls
-how characters and strings written to the port are converted to bytes.
-When ports are created, they inherit their character encoding from the
-current locale, but, that can be modified after the port is created.
+read from the port are converted to characters and controls how
+characters written to the port are converted to bytes. When ports are
+created, they inherit their character encoding from the current locale,
+but, that can be modified after the port is created.
Currently, the ports only work with @emph{non-modal} encodings. Most
encodings are non-modal, meaning that the conversion of bytes to a
@@ -88,6 +84,15 @@ representation for output. There are three possible
strategies: to
raise an error, to replace the character with a hex escape, or to
replace the character with a substitute character.
+Finally, all ports have associated input and output buffers, as
+appropriate. Buffering is a common strategy to limit the overhead of
+small reads and writes: without buffering, each character fetched from a
+file would involve at least one call into the kernel, and maybe more
+depending on the character and the encoding. Instead, Guile will batch
+reads and writes into internal buffers. However, sometimes you want to
+make output on a port show up immediately. @xref{Buffering}, for more
+on interfaces to control port buffering.
+
@rnindex input-port?
@deffn {Scheme Procedure} input-port? x
@deffnx {C Function} scm_input_port_p (x)
@@ -188,8 +193,6 @@ equivalent to @code{(fluid-set!
%default-port-conversion-strategy
@subsection Reading
@cindex Reading
-[Generic procedures for reading from ports.]
-
These procedures pertain to reading characters and strings from
ports. To read general S-expressions from ports, @xref{Scheme Read}.
@@ -325,8 +328,6 @@ Set the current column or line number of @var{port}.
@subsection Writing
@cindex Writing
-[Generic procedures for writing to ports.]
-
These procedures are for writing characters and strings to
ports. For more information on writing arbitrary Scheme objects to
ports, @xref{Scheme Write}.
@@ -380,6 +381,14 @@ Note that this function does not update @code{port-line}
and
@code{port-column} (@pxref{Reading}).
@end deftypefn
address@hidden {C Function} void scm_lfwrite (const char *buffer, size_t size,
SCM port)
+Write @var{size} bytes at @var{buffer} to @var{port}. The @code{lf}
+indicates that unlike @code{scm_c_write}, this function updates the
+port's @code{port-line} and @code{port-column}, and also flushes the
+port if the data contains a newline (@code{\n}) and the port is
+line-buffered.
address@hidden deftypefn
+
@findex fflush
@deffn {Scheme Procedure} force-output [port]
@deffnx {C Function} scm_force_output (port)
@@ -435,6 +444,96 @@ open.
@end deffn
address@hidden Buffering
address@hidden Buffering
address@hidden Port, buffering
+
+Every port has associated input and output buffers. You can think of
+ports as being backed by some mutable store, and that store might be far
+away. For example, ports backed by file descriptors have to go all the
+way to the kernel to read and write their data. To avoid this
+round-trip cost, Guile usually reads in data from the mutable store in
+chunks, and then services small requests like @code{get-char} out of
+that intermediate buffer. Similarly, small writes like
address@hidden first go to a buffer, and are sent to the store when
+the buffer is full (or when port is flushed). Buffered ports speed up
+your program by reducing the number of round-trips to the mutable store,
+and the do so in a way that is mostly transparent to the user.
+
+There are two major ways, however, in which buffering affects program
+semantics. Building correct, performant programs requires understanding
+these situations.
+
+The first case is in random-access read/write ports (@pxref{Random
+Access}). These ports, usually backed by a file, logically operate over
+the same mutable store when both reading and writing. So, if you read a
+character, causing the buffer to fill, then write a character, the bytes
+you filled in your read buffer are now invalid. Every time you switch
+between reading and writing, Guile has to flush any pending buffer. If
+this happens frequently, the cost can be high. In that case you should
+reduce the amount that you buffer, in both directions. Similarly, Guile
+has to flush buffers before seeking. None of these considerations apply
+to sockets, which don't logically read from and write to the same
+mutable store, and are not seekable. Note also that sockets are
+unbuffered by default. @xref{Network Sockets and Communication}.
+
+The second case is the more pernicious one. If you write data to a
+buffered port, it probably hasn't gone out to the mutable store yet.
+(This ``probably'' introduces some indeterminism in your program: what
+goes to the store, and when, depends on how full the buffer is. It is
+something that the user needs to explicitly be aware of.) The data is
+written to the store later -- when the buffer fills up due to another
+write, or when @code{force-output} is called, or when @code{close-port}
+is called, or when the program exits, or even when the garbage collector
+runs. The salient point is, @emph{the errors are signalled then too}.
+Buffered writes defer error detection (and defer the side effects to the
+mutable store), perhaps indefinitely if the port type does not need to
+be closed at GC.
+
+One common heuristic that works well for textual ports is to flush
+output when a newline (@code{\n}) is written. This @dfn{line buffering}
+mode is on by default for TTY ports. Most other ports are @dfn{block
+buffered}, meaning that once the output buffer reaches the block size,
+which depends on the port and its configuration, the output is flushed
+as a block, without regard to what is in the block. Likewise reads are
+read in at the block size, though if there are fewer bytes available to
+read, the buffer may not be entirely filled.
+
+Note that reads or writes that are larger than the buffer size go
+directly to the mutable store without passing through the buffers. If
+your access pattern involves many big reads or writes, buffering might
+not matter so much to you.
+
+To control the buffering behavior of a port, use @code{setvbuf}.
+
address@hidden {Scheme Procedure} setvbuf port mode [size]
address@hidden {C Function} scm_setvbuf (port, mode, size)
address@hidden port buffering
+Set the buffering mode for @var{port}. @var{mode} can be one of the
+following symbols:
+
address@hidden @code
address@hidden none
+non-buffered
address@hidden line
+line buffered
address@hidden block
+block buffered, using a newly allocated buffer of @var{size} bytes.
+If @var{size} is omitted, a default size will be used.
address@hidden table
address@hidden deffn
+
+Another way to set the buffering, for file ports, is to open the file
+with @code{0} or @code{l} as part of the mode string, for unbuffered or
+line-buffered ports, respectively. @xref{File Ports}, for more.
+
+All of these considerations are very similar to those of streams in the
+C library, although Guile's ports are not built on top of C streams.
+Still, it is useful to read what other systems do.
address@hidden,,,libc,The GNU C Library Reference Manual}, for more
+discussion on C streams.
+
+
@node Random Access
@subsection Random Access
@cindex Random access, ports
@@ -882,8 +981,7 @@ Create an "unbuffered" port. In this case input and output
operations are passed directly to the underlying port
implementation without additional buffering. This is likely to
slow down I/O operations. The buffering mode can be changed
-while a port is in use @pxref{Ports and File Descriptors,
-setvbuf}
+while a port is in use (@pxref{Buffering}).
@item l
Add line-buffering to the port. The port output buffer will be
automatically flushed whenever a newline character is written.
@@ -1797,8 +1895,7 @@ 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).
+can be changed using @code{setvbuf} (@pxref{Buffering}).
Using a custom binary input port, the @code{open-bytevector-input-port}
procedure could be implemented as follows:
@@ -2157,152 +2254,111 @@ the representation, will return an object equal (in
the sense of
@end deffn
@node I/O Extensions
address@hidden Using and Extending Ports in C
-
address@hidden
-* C Port Interface:: Using ports from C.
-* Port Implementation:: How to implement a new port type in C.
address@hidden menu
-
-
address@hidden C Port Interface
address@hidden C Port Interface
address@hidden C port interface
address@hidden Port, C interface
address@hidden Implementing New Port Types in C
-This section describes how to use Scheme ports from C.
-
address@hidden Port basics
+This section describes how to implement a new port type in C. Before
+getting to the details, here is a summary of how the generic port
+interface works internally.
@cindex ptob
address@hidden scm_ptob_descriptor
address@hidden scm_port
address@hidden scm_t_ptob_descriptor
address@hidden scm_t_port
address@hidden scm_t_port_buffer
@findex SCM_PTAB_ENTRY
@findex SCM_PTOBNUM
@vindex scm_ptobs
-There are two main data structures. A port type object (ptob) is of
-type @code{scm_ptob_descriptor}. A port instance is of type
address@hidden Given an @code{SCM} variable which points to a port,
-the corresponding C port object can be obtained using the
address@hidden macro. The ptob can be obtained by using
address@hidden to give an index into the @code{scm_ptobs}
-global array.
+Guile's port facility consists of three main data structures. A port
+type object (ptob) is of type @code{scm_t_ptob_descriptor}, and holds
+pointers to the methods that implement the port type. A port instance
+is of type @code{scm_t_port}, and holds all state for the port. Finally
+the read and write buffers are the @code{read_buf} and @code{write_buf}
+members of the port instance, and are of type @code{scm_t_port_buffer}.
+
+Given an @code{SCM} variable which points to a port, the corresponding C
+port object can be obtained using the @code{SCM_PTAB_ENTRY} macro. The
+ptob can be obtained by using @code{SCM_PTOBNUM} to give an index into
+the @code{scm_ptobs} global array.
@subsubheading Port buffers
An input port always has a read buffer and an output port always has a
-write buffer. However the size of these buffers is not guaranteed to be
-more than one byte (e.g., the @code{shortbuf} field in @code{scm_port}
-which is used when no other buffer is allocated). The way in which the
-buffers are allocated depends on the implementation of the ptob. For
-example in the case of an fport, buffers may be allocated with malloc
-when the port is created, but in the case of an strport the underlying
-string is used as the buffer.
+write buffer. @xref{Buffering}. These buffers are represented in C by
address@hidden objects.
+
+The port buffer consists of data as a byte array, pointed to by its
address@hidden field. The valid data in the buffer is between the
address@hidden and @code{end} indices into @code{buf}; @code{cur} must
+always be less than or equal to @code{end}, which in turn must be less
+than or equal to the buffer size @code{size}.
+
+``Valid data'' for a read buffer is data that has been buffered, but not
+yet read by the user. A port's @code{read} procedure fills a read
+buffer from the @code{end} element. For a write buffer, the ``valid
+data'' is data which has been written by the user, but not yet flushed
+to the mutable store. A port's @code{write} procedure will consume the
+data between @code{cur} and @code{end} (not including @code{end}) and
+advance @code{cur}.
+
+The size of the buffers is controlled by the user, via @code{setvbuf}.
+A port implementation can provide an idea of what the ``natural'' size
+for its buffers are, but it has no guarantee that the buffer will be
+those sizes. It's also possible for big reads or writes to work on
+auxiliary buffers, and it's possible for @code{unget-bytevector} to
+cause a read buffer to expand temporarily; port implementations can't
+assume that the buffer they have been given to fill or empty corresponds
+to the port's designated read or write buffer.
+
+Port read buffers also have a flag indicating that the last read did not
+advance @code{end}, which indicates end-of-stream. It is cleared by
+Guile when Guile gives the user an EOF object.
@subsubheading The @code{rw_random} flag
Special treatment is required for ports which can be seeked at random.
Before various operations, such as seeking the port or changing from
-input to output on a bidirectional port or vice versa, the port
-implementation must be given a chance to update its state. The write
-buffer is updated by calling the @code{flush} ptob procedure and the
-input buffer is updated by calling the @code{end_input} ptob procedure.
-In the case of an fport, @code{flush} causes buffered output to be
-written to the file descriptor, while @code{end_input} causes the
-descriptor position to be adjusted to account for buffered input which
-was never read.
-
-The special treatment must be performed if the @code{rw_random} flag in
-the port is non-zero.
-
address@hidden The @code{rw_active} variable
-
-The @code{rw_active} variable in the port is only used if
address@hidden is set. It's defined as an enum with the following
-values:
-
address@hidden @code
address@hidden SCM_PORT_READ
-the read buffer may have unread data.
-
address@hidden SCM_PORT_WRITE
-the write buffer may have unwritten data.
-
address@hidden SCM_PORT_NEITHER
-neither the write nor the read buffer has data.
address@hidden table
-
address@hidden Reading from a port.
-
-To read from a port, it's possible to either call existing libguile
-procedures such as @code{scm_getc} and @code{scm_read_line} or to read
-data from the read buffer directly. Reading from the buffer involves
-the following steps:
-
address@hidden
address@hidden
-Flush output on the port, if @code{rw_active} is @code{SCM_PORT_WRITE}.
-
address@hidden
-Fill the read buffer, if it's empty, using @code{scm_fill_input}.
-
address@hidden Read the data from the buffer and update the read position in
-the buffer. Steps 2) and 3) may be repeated as many times as required.
-
address@hidden Set rw_active to @code{SCM_PORT_READ} if @code{rw_random} is set.
-
address@hidden update the port's line and column counts.
address@hidden enumerate
-
address@hidden Writing to a port.
-
-To write data to a port, calling @code{scm_lfwrite} should be sufficient for
-most purposes. This takes care of the following steps:
-
address@hidden
address@hidden
-End input on the port, if @code{rw_active} is @code{SCM_PORT_READ}.
-
address@hidden
-Pass the data to the ptob implementation using the @code{write} ptob
-procedure. The advantage of using the ptob @code{write} instead of
-manipulating the write buffer directly is that it allows the data to be
-written in one operation even if the port is using the single-byte
address@hidden
-
address@hidden
-Set @code{rw_active} to @code{SCM_PORT_WRITE} if @code{rw_random}
-is set.
address@hidden enumerate
-
-
address@hidden Port Implementation
address@hidden Port Implementation
address@hidden Port implementation
-
-This section describes how to implement a new port type in C.
-
-As described in the previous section, a port type object (ptob) is
-a structure of type @code{scm_ptob_descriptor}. A ptob is created by
-calling @code{scm_make_port_type}.
-
address@hidden scm_t_bits scm_make_port_type (char *name, int (*fill_input)
(SCM port), void (*write) (SCM port, const void *data, size_t size))
-Return a new port type object. The @var{name}, @var{fill_input} and
address@hidden parameters are initial values for those port type fields,
-as described below. The other fields are initialized with default
-values and can be changed later.
+input to output on a bidirectional port or vice versa. Seeking on a
+port with buffered input, or switching to writing after reading, will
+cause the buffered input to be discarded and Guile will seek the port
+back the buffered number of bytes. Likewise seeking on a port with
+buffered output, or switching to reading after writing, will flush
+pending bytes with a call to the @code{write} procedure. Indicate to
+Guile that your port needs this behavior by setting the @code{rw_random}
+flag. This flag is set by default if the port type supplies a seek
+implementation.
+
address@hidden C interface
+
+A port type object is created by calling @code{scm_make_port_type}.
+
address@hidden scm_t_bits scm_make_port_type (char *name, void (*read) (SCM
port, scm_t_port_buffer *dst), void (*write) (SCM port, scm_t_port_buffer *src))
+Return a new port type object. The @var{name}, @var{read} and
address@hidden parameters are initial values for those port type fields, as
+described below. The other fields are initialized with default values
+and can be changed later.
@end deftypefun
-All of the elements of the ptob, apart from @code{name}, are procedures
-which collectively implement the port behaviour. Creating a new port
-type mostly involves writing these procedures.
+All of the elements of the port type object, apart from @code{name}, are
+procedures which collectively implement the port behaviour. Creating a
+new port type mostly involves writing these procedures.
@table @code
@item name
A pointer to a NUL terminated string: the name of the port type. This
-is the only element of @code{scm_ptob_descriptor} which is not
+is the only element of @code{scm_t_ptob_descriptor} which is not
a procedure. Set via the first argument to @code{scm_make_port_type}.
address@hidden read
+A port's @code{read} implementation fills read buffers. It should copy
+bytes to the supplied port buffer object, advancing the buffer's
address@hidden field as appropriate, but not past the buffer's @code{size}
+field.
+
address@hidden write
+A port's @code{write} implementation flushes write buffers to the
+mutable store. It should copy bytes from the supplied port buffer
+object, advancing the buffer's @code{cur} field as appropriate, but not
+past the buffer's @code{end} field.
+
@item print
Called when @code{write} is called on the port object, to print a
port description. E.g., for an fport it may produce something like:
@@ -2329,70 +2385,16 @@ port type as needing a close on GC.
@deftypefun void scm_set_port_needs_close_on_gc (scm_t_bits tc, int
needs_close_p)
@end deftypefun
address@hidden write
-Accept data which is to be written using the port. The port implementation
-may choose to buffer the data instead of processing it directly.
-Set via the third argument to @code{scm_make_port_type}.
-
address@hidden flush
-Complete the processing of buffered output data. Reset the value of
address@hidden to @code{SCM_PORT_NEITHER}.
-Set using
-
address@hidden void scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port))
address@hidden deftypefun
-
address@hidden end_input
-Perform any synchronization required when switching from input to output
-on the port. Reset the value of @code{rw_active} to @code{SCM_PORT_NEITHER}.
-Set using
-
address@hidden void scm_set_port_end_input (scm_t_bits tc, void (*end_input)
(SCM port, int offset))
address@hidden deftypefun
-
address@hidden fill_input
-Read new data into the read buffer and return the first character. It
-can be assumed that the read buffer is empty when this procedure is called.
-Set via the second argument to @code{scm_make_port_type}.
-
address@hidden input_waiting
-Return a lower bound on the number of bytes that could be read from the
-port without blocking. It can be assumed that the current state of
address@hidden is @code{SCM_PORT_NEITHER}.
-Set using
-
address@hidden void scm_set_port_input_waiting (scm_t_bits tc, int
(*input_waiting) (SCM port))
address@hidden deftypefun
-
@item seek
-Set the current position of the port. The procedure can not make
-any assumptions about the value of @code{rw_active} when it's
-called. It can reset the buffers first if desired by using something
-like:
-
address@hidden
-if (pt->rw_active == SCM_PORT_READ)
- scm_end_input (port);
-else if (pt->rw_active == SCM_PORT_WRITE)
- ptob->flush (port);
address@hidden example
-
-However note that this will have the side effect of discarding any data
-in the unread-char buffer, in addition to any side effects from the
address@hidden and @code{flush} ptob procedures. This is undesirable
-when seek is called to measure the current position of the port, i.e.,
address@hidden(seek p 0 SEEK_CUR)}. The libguile fport and string port
-implementations take care to avoid this problem.
-
-The procedure is set using
+Set the current position of the port. Guile will flush read and/or
+write buffers before seeking, as appropriate.
@deftypefun void scm_set_port_seek (scm_t_bits tc, scm_t_off (*seek) (SCM
port, scm_t_off offset, int whence))
@end deftypefun
@item truncate
-Truncate the port data to be specified length. It can be assumed that the
-current state of @code{rw_active} is @code{SCM_PORT_NEITHER}.
-Set using
+Truncate the port data to be specified length. Guile will flush buffers
+before hand, as appropriate. Set using
@deftypefun void scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM
port, scm_t_off length))
@end deftypefun
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index e5f1232..53a71c1 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -133,18 +133,6 @@ then the return is @code{#f}. For example,
Conventions generally follow those of scsh, @ref{The Scheme shell (scsh)}.
-File ports are implemented using low-level operating system I/O
-facilities, with optional buffering to improve efficiency; see
address@hidden Ports}.
-
-Note that some procedures (e.g., @code{recv!}) will accept ports as
-arguments, but will actually operate directly on the file descriptor
-underlying the port. Any port buffering is ignored, including the
-buffer which implements @code{peek-char} and @code{unread-char}.
-
-The @code{force-output} and @code{drain-input} procedures can be used
-to clear the buffers.
-
Each open file port has an associated operating system file descriptor.
File descriptors are generally not useful in Scheme programs; however
they may be needed when interfacing with foreign code and the Unix
@@ -181,6 +169,22 @@ initially set to one, so that dropping references to one
of these
ports will not result in its garbage collection: it could be retrieved
with @code{fdopen} or @code{fdes->ports}.
+Guile's ports can be buffered. This means that writing a byte to a file
+port goes to the internal buffer first, and only when the buffer is full
+(or the user invokes @code{force-output} on the port) is the data
+actually written to the file descriptor. Likewise on input, bytes are
+read in from the file descriptor in blocks and placed in a buffer.
+Reading a character via @code{read-char} first goes to the buffer,
+filling it as needed. Usually read buffering is more or less
+transparent, but write buffering can sometimes cause writes to be
+delayed unexpectedly, if you forget to call @code{force-output}.
address@hidden, for more on how to control port buffers.
+
+Note however that some procedures (e.g., @code{recv!}) will accept ports
+as arguments, but will actually operate directly on the file descriptor
+underlying the port. Any port buffering is ignored, including the
+buffer which implements @code{peek-char} and @code{unread-char}.
+
@deffn {Scheme Procedure} port-revealed port
@deffnx {C Function} scm_port_revealed (port)
Return the revealed count for @var{port}.
@@ -314,32 +318,16 @@ the file descriptor will be closed even if a port is
using it. The
return value is unspecified.
@end deffn
address@hidden {Scheme Procedure} unread-char char [port]
address@hidden {C Function} scm_unread_char (char, port)
-Place @var{char} in @var{port} so that it will be read by the next
-read operation on that port. If called multiple times, the unread
-characters will be read again in ``last-in, first-out'' order (i.e.@:
-a stack). If @var{port} is not supplied, the current input port is
-used.
address@hidden deffn
-
address@hidden {Scheme Procedure} unread-string str port
-Place the string @var{str} in @var{port} so that its characters will be
-read in subsequent read operations. If called multiple times, the
-unread characters will be read again in last-in first-out order. If
address@hidden is not supplied, the current-input-port is used.
address@hidden deffn
-
@deffn {Scheme Procedure} pipe
@deffnx {C Function} scm_pipe ()
@cindex pipe
-Return a newly created pipe: a pair of ports which are linked
-together on the local machine. The @acronym{CAR} is the input
-port and the @acronym{CDR} is the output port. Data written (and
-flushed) to the output port can be read from the input port.
-Pipes are commonly used for communication with a newly forked
-child process. The need to flush the output port can be
-avoided by making it unbuffered using @code{setvbuf}.
+Return a newly created pipe: a pair of ports which are linked together
+on the local machine. The @acronym{CAR} is the input port and the
address@hidden is the output port. Data written (and flushed) to the
+output port can be read from the input port. Pipes are commonly used
+for communication with a newly forked child process. The need to flush
+the output port can be avoided by making it unbuffered using
address@hidden (@pxref{Buffering}).
@defvar PIPE_BUF
A write of up to @code{PIPE_BUF} many bytes to a pipe is atomic,
@@ -2286,11 +2274,10 @@ don't have file descriptors for the child, then
@file{/dev/null} is
used instead.
Care should be taken with @code{OPEN_BOTH}, a deadlock will occur if
-both parent and child are writing, and waiting until the write
-completes before doing any reading. Each direction has
address@hidden bytes of buffering (@pxref{Ports and File
-Descriptors}), which will be enough for small writes, but not for say
-putting a big file through a filter.
+both parent and child are writing, and waiting until the write completes
+before doing any reading. Each direction has @code{PIPE_BUF} bytes of
+buffering (@pxref{Buffering}), which will be enough for small writes,
+but not for say putting a big file through a filter.
@end deffn
@deffn {Scheme Procedure} open-input-pipe command
@@ -3057,7 +3044,7 @@ release the returned structure when no longer required.
Socket ports can be created using @code{socket} and @code{socketpair}.
The ports are initially unbuffered, to make reading and writing to the
same port more reliable. A buffer can be added to the port using
address@hidden; see @ref{Ports and File Descriptors}.
address@hidden (@pxref{Buffering}).
Most systems have limits on how many files and sockets can be open, so
it's strongly recommended that socket ports be closed explicitly when
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 95d1a9d..03a0b06 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -652,7 +652,7 @@ set_element (fd_set *set, SCM *ports_ready, SCM element,
int pos)
/* check whether port has buffered input. */
scm_t_port *pt = SCM_PTAB_ENTRY (element);
- if (pt->read_pos < pt->read_end)
+ if (pt->read_buf->cur < pt->read_buf->end)
use_buf = 1;
}
else if (pos == SCM_ARG2)
@@ -661,7 +661,7 @@ set_element (fd_set *set, SCM *ports_ready, SCM element,
int pos)
scm_t_port *pt = SCM_PTAB_ENTRY (element);
/* > 1 since writing the last byte in the buffer causes flush. */
- if (pt->write_end - pt->write_pos > 1)
+ if (pt->write_buf->size - pt->write_buf->end > 1)
use_buf = 1;
}
fd = use_buf ? -1 : SCM_FPORT_FDES (element);
diff --git a/libguile/fports.c b/libguile/fports.c
index 963c1ea..3e47562 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -75,67 +75,6 @@
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 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, long write_size)
-#define FUNC_NAME "scm_fport_buffer_add"
-{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (read_size == -1 || write_size == -1)
- {
- size_t default_size;
-#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
- struct stat st;
- scm_t_fport *fp = SCM_FSTREAM (port);
-
- default_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size
- : st.st_blksize;
-#else
- default_size = default_buffer_size;
-#endif
- if (read_size == -1)
- read_size = default_size;
- if (write_size == -1)
- write_size = default_size;
- }
-
- if (SCM_INPUT_PORT_P (port) && read_size > 0)
- {
- pt->read_buf = scm_gc_malloc_pointerless (read_size, "port buffer");
- pt->read_pos = pt->read_end = pt->read_buf;
- pt->read_buf_size = read_size;
- }
- else
- {
- pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
- pt->read_buf_size = 1;
- }
-
- if (SCM_OUTPUT_PORT_P (port) && write_size > 0)
- {
- pt->write_buf = scm_gc_malloc_pointerless (write_size, "port buffer");
- pt->write_pos = pt->write_buf;
- pt->write_buf_size = write_size;
- }
- else
- {
- pt->write_buf = pt->write_pos = &pt->shortbuf;
- pt->write_buf_size = 1;
- }
-
- pt->write_end = pt->write_buf + pt->write_buf_size;
- if (read_size > 0 || write_size > 0)
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
- else
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);
-}
-#undef FUNC_NAME
-
/* Move ports with the specified file descriptor to new descriptors,
* resetting the revealed count to 0.
*/
@@ -480,12 +419,6 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
port = scm_c_make_port (scm_tc16_fport, mode_bits, (scm_t_bits)fp);
SCM_PTAB_ENTRY (port)->rw_random = SCM_FDES_RANDOM_P (fdes);
-
- if (mode_bits & SCM_BUF0)
- scm_fport_buffer_add (port, 0, 0);
- else
- scm_fport_buffer_add (port, -1, -1);
-
SCM_SET_FILENAME (port, name);
return port;
@@ -643,28 +576,31 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate
SCM_UNUSED)
return 1;
}
-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 scm_t_wchar
-fport_fill_input (SCM port)
+static void
+fport_read (SCM port, scm_t_port_buffer *dst)
{
long count;
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
scm_t_fport *fp = SCM_FSTREAM (port);
+ scm_t_uint8 *ptr = dst->buf + dst->end;
+ size_t size = dst->size - dst->end;
- SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size));
+ SCM_SYSCALL (count = read (fp->fdes, ptr, size));
if (count == -1)
- scm_syserror ("fport_fill_input");
- if (count == 0)
- return (scm_t_wchar) EOF;
- else
- {
- pt->read_pos = pt->read_buf;
- pt->read_end = pt->read_buf + count;
- return *pt->read_buf;
- }
+ scm_syserror ("fport_read");
+ dst->end += count;
+}
+
+static void
+fport_write (SCM port, scm_t_port_buffer *src)
+{
+ int fd = SCM_FPORT_FDES (port);
+ scm_t_uint8 *ptr = src->buf + src->cur;
+ size_t size = src->end - src->cur;
+
+ if (full_write (fd, ptr, size) < size)
+ scm_syserror ("fport_write");
}
static scm_t_off
@@ -691,121 +627,10 @@ fport_truncate (SCM port, scm_t_off length)
}
static void
-fport_write (SCM port, const void *data, size_t size)
-#define FUNC_NAME "fport_write"
-{
- /* this procedure tries to minimize the number of writes/flushes. */
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (pt->write_buf == &pt->shortbuf
- || (pt->write_pos == pt->write_buf && size >= pt->write_buf_size))
- {
- /* Unbuffered port, or port with empty buffer and data won't fit in
- buffer. */
- if (full_write (SCM_FPORT_FDES (port), data, size) < size)
- SCM_SYSERROR;
-
- return;
- }
-
- {
- scm_t_off space = pt->write_end - pt->write_pos;
-
- if (size <= space)
- {
- /* data fits in buffer. */
- memcpy (pt->write_pos, data, size);
- pt->write_pos += size;
- if (pt->write_pos == pt->write_end)
- {
- fport_flush (port);
- /* we can skip the line-buffering check if nothing's buffered. */
- return;
- }
- }
- else
- {
- memcpy (pt->write_pos, data, space);
- pt->write_pos = pt->write_end;
- fport_flush (port);
- {
- const void *ptr = ((const char *) data) + space;
- size_t remaining = size - space;
-
- if (size >= pt->write_buf_size)
- {
- if (full_write (SCM_FPORT_FDES (port), ptr, remaining)
- < remaining)
- SCM_SYSERROR;
- return;
- }
- else
- {
- memcpy (pt->write_pos, ptr, remaining);
- pt->write_pos += remaining;
- }
- }
- }
- }
-}
-#undef FUNC_NAME
-
-static void
-fport_flush (SCM port)
-{
- size_t written;
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
- scm_t_fport *fp = SCM_FSTREAM (port);
- size_t count = pt->write_pos - pt->write_buf;
-
- written = full_write (fp->fdes, pt->write_buf, count);
- if (written < count)
- scm_syserror ("scm_flush");
-
- pt->write_pos = pt->write_buf;
-}
-
-/* clear the read buffer and adjust the file position for unread bytes. */
-static void
-fport_end_input (SCM port, int offset)
-{
- scm_t_fport *fp = SCM_FSTREAM (port);
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- offset += pt->read_end - pt->read_pos;
-
- if (offset > 0)
- {
- pt->read_pos = pt->read_end;
- /* will throw error if unread-char used at beginning of file
- then attempting to write. seems correct. */
- if (lseek (fp->fdes, -offset, SEEK_CUR) == -1)
- scm_syserror ("fport_end_input");
- }
-}
-
-static void
-close_the_fd (void *data)
-{
- scm_t_fport *fp = data;
-
- close (fp->fdes);
- /* There's already one exception. That's probably enough! */
- errno = 0;
-}
-
-static void
fport_close (SCM port)
{
scm_t_fport *fp = SCM_FSTREAM (port);
- scm_dynwind_begin (0);
- scm_dynwind_unwind_handler (close_the_fd, fp, 0);
- fport_flush (port);
- scm_dynwind_end ();
-
- scm_port_non_buffer (SCM_PTAB_ENTRY (port));
-
if (close (fp->fdes) != 0)
/* It's not useful to retry after EINTR, as the file descriptor is
in an undefined state. See http://lwn.net/Articles/365294/.
@@ -814,20 +639,31 @@ fport_close (SCM port)
scm_syserror ("fport_close");
}
+/* Query the OS to get the natural buffering for FPORT, if available. */
+static void
+fport_get_natural_buffer_sizes (SCM port, size_t *read_size, size_t
*write_size)
+{
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+ scm_t_fport *fp = SCM_FSTREAM (port);
+ struct stat st;
+
+ if (fstat (fp->fdes, &st) == 0)
+ *read_size = *write_size = st.st_blksize;
+#endif
+}
+
static scm_t_bits
scm_make_fptob ()
{
- scm_t_bits tc = scm_make_port_type ("file", fport_fill_input, fport_write);
-
- scm_set_port_needs_close_on_gc (tc, 1);
- scm_set_port_print (tc, fport_print);
- scm_set_port_flush (tc, fport_flush);
- scm_set_port_end_input (tc, fport_end_input);
- scm_set_port_close (tc, fport_close);
- 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, scm_fport_buffer_add);
+ scm_t_bits tc = scm_make_port_type ("file", fport_read, fport_write);
+
+ scm_set_port_print (tc, fport_print);
+ scm_set_port_needs_close_on_gc (tc, 1);
+ scm_set_port_close (tc, fport_close);
+ 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_get_natural_buffer_sizes (tc, fport_get_natural_buffer_sizes);
return tc;
}
diff --git a/libguile/ioext.c b/libguile/ioext.c
index 25ce014..607eec6 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -86,19 +86,23 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
newfd = fp->fdes;
if (oldfd != newfd)
{
- scm_t_port *pt = SCM_PTAB_ENTRY (new);
- scm_t_port *old_pt = SCM_PTAB_ENTRY (old);
-
- /* must flush to old fdes. */
- if (pt->rw_active == SCM_PORT_WRITE)
- scm_flush_unlocked (new);
- else if (pt->rw_active == SCM_PORT_READ)
- scm_end_input_unlocked (new);
+ /* Ensure there is nothing in either port's input or output
+ buffers. */
+ if (SCM_OUTPUT_PORT_P (old))
+ scm_flush_unlocked (old);
+ if (SCM_INPUT_PORT_P (old))
+ scm_end_input_unlocked (old);
+
+ if (SCM_OUTPUT_PORT_P (new))
+ scm_flush_unlocked (new);
+ if (SCM_INPUT_PORT_P (new))
+ scm_end_input_unlocked (new);
+
ans = dup2 (oldfd, newfd);
if (ans == -1)
SCM_SYSERROR;
- pt->rw_random = old_pt->rw_random;
- /* continue using existing buffers, even if inappropriate. */
+
+ SCM_PTAB_ENTRY (new)->rw_random = SCM_PTAB_ENTRY (old)->rw_random;
}
return SCM_UNSPECIFIED;
}
diff --git a/libguile/poll.c b/libguile/poll.c
index 90a5c05..1e8fa7a 100644
--- a/libguile/poll.c
+++ b/libguile/poll.c
@@ -108,11 +108,11 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM
timeout)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
- if (pt->read_pos < pt->read_end)
+ if (pt->read_buf->cur < pt->read_buf->end)
/* Buffered input waiting to be read. */
revents |= POLLIN;
if (SCM_OUTPUT_PORT_P (port)
- && pt->write_end - pt->write_pos > 1)
+ && pt->write_buf->size - pt->write_buf->end > 1)
/* Buffered output possible. The "> 1" is because
writing the last byte would flush the port. */
revents |= POLLOUT;
@@ -146,11 +146,11 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM
timeout)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
- if (pt->read_pos < pt->read_end)
+ if (pt->read_buf->cur < pt->read_buf->end)
/* Buffered input waiting to be read. */
revents |= POLLIN;
if (SCM_OUTPUT_PORT_P (port)
- && pt->write_end - pt->write_pos > 1)
+ && pt->write_buf->size - pt->write_buf->end > 1)
/* Buffered output possible. The "> 1" is because
writing the last byte would flush the port. */
revents |= POLLOUT;
diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h
index bff89cb..1a94bd5 100644
--- a/libguile/ports-internal.h
+++ b/libguile/ports-internal.h
@@ -50,7 +50,6 @@ struct scm_port_internal
unsigned at_stream_start_for_bom_write : 1;
scm_t_port_encoding_mode encoding_mode;
scm_t_iconv_descriptors *iconv_descriptors;
- int pending_eof;
SCM alist;
};
diff --git a/libguile/ports.c b/libguile/ports.c
index b8d2616..8f07425 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -224,26 +224,13 @@ scm_c_port_type_add_x (scm_t_ptob_descriptor *desc)
return ret;
}
-/*
- * We choose to use an interface similar to the smob interface with
- * fill_input and write as standard fields, passed to the port
- * type constructor, and optional fields set by setters.
- */
-
-static void
-flush_port_default (SCM port SCM_UNUSED)
-{
-}
-
-static void
-end_input_default (SCM port SCM_UNUSED, int offset SCM_UNUSED)
-{
-}
+/* Default buffer size. Used if the port type won't supply a value. */
+static const size_t default_buffer_size = 1024;
scm_t_bits
scm_make_port_type (char *name,
- int (*fill_input) (SCM port),
- void (*write) (SCM port, const void *data, size_t size))
+ void (*read) (SCM port, scm_t_port_buffer *buf),
+ void (*write) (SCM port, scm_t_port_buffer *buf))
{
scm_t_ptob_descriptor *desc;
long ptobnum;
@@ -253,10 +240,8 @@ scm_make_port_type (char *name,
desc->name = name;
desc->print = scm_port_print;
+ desc->read = read;
desc->write = write;
- desc->flush = flush_port_default;
- desc->end_input = end_input_default;
- desc->fill_input = fill_input;
ptobnum = scm_c_port_type_add_x (desc);
@@ -292,18 +277,6 @@ scm_set_port_needs_close_on_gc (scm_t_bits tc, int
needs_close_p)
}
void
-scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port))
-{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->flush = flush;
-}
-
-void
-scm_set_port_end_input (scm_t_bits tc, void (*end_input) (SCM port, int
offset))
-{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->end_input = end_input;
-}
-
-void
scm_set_port_seek (scm_t_bits tc, scm_t_off (*seek) (SCM, scm_t_off, int))
{
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->seek = seek;
@@ -322,21 +295,23 @@ scm_set_port_input_waiting (scm_t_bits tc, int
(*input_waiting) (SCM))
}
void
-scm_set_port_setvbuf (scm_t_bits tc, void (*setvbuf) (SCM, long, long))
+scm_set_port_get_natural_buffer_sizes
+ (scm_t_bits tc, void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *))
{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->setvbuf = setvbuf;
+ scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
+ ptob->get_natural_buffer_sizes = get_natural_buffer_sizes;
}
static void
scm_i_set_pending_eof (SCM port)
{
- SCM_PORT_GET_INTERNAL (port)->pending_eof = 1;
+ SCM_PTAB_ENTRY (port)->read_buf->has_eof = 1;
}
static void
scm_i_clear_pending_eof (SCM port)
{
- SCM_PORT_GET_INTERNAL (port)->pending_eof = 0;
+ SCM_PTAB_ENTRY (port)->read_buf->has_eof = 0;
}
SCM_DEFINE (scm_i_port_property, "%port-property", 2, 0, 0,
@@ -544,6 +519,22 @@ scm_i_dynwind_current_load_port (SCM port)
+/* Port buffers. */
+
+scm_t_port_buffer *
+scm_c_make_port_buffer (size_t size)
+{
+ scm_t_port_buffer *ret = scm_gc_typed_calloc (scm_t_port_buffer);
+
+ ret->size = size;
+ ret->buf = scm_gc_malloc_pointerless (ret->size, "port buffer");
+
+ return ret;
+}
+
+
+
+
/* Retrieving a port's mode. */
/* Return the flags that characterize a port based on the mode
@@ -656,6 +647,36 @@ finalize_port (void *ptr, void *data)
+static void
+initialize_port_buffers (SCM port)
+{
+ scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
+ size_t read_buf_size, write_buf_size;
+
+ if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
+ read_buf_size = write_buf_size = 1;
+ else
+ {
+ read_buf_size = write_buf_size = default_buffer_size;
+ if (ptob->get_natural_buffer_sizes)
+ ptob->get_natural_buffer_sizes (port, &read_buf_size, &write_buf_size);
+ if (read_buf_size == 0)
+ read_buf_size = 1;
+ if (write_buf_size == 0)
+ write_buf_size = 1;
+ }
+
+ if (!SCM_INPUT_PORT_P (port))
+ read_buf_size = 1;
+ if (!SCM_OUTPUT_PORT_P (port))
+ write_buf_size = 1;
+
+ pt->read_buffering = read_buf_size;
+ pt->read_buf = scm_c_make_port_buffer (read_buf_size);
+ pt->write_buf = scm_c_make_port_buffer (write_buf_size);
+}
+
SCM
scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
const char *encoding,
@@ -709,7 +730,6 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned
long mode_bits,
pti->at_stream_start_for_bom_read = 1;
pti->at_stream_start_for_bom_write = 1;
- pti->pending_eof = 0;
pti->alist = SCM_EOL;
if (SCM_PORT_DESCRIPTOR (ret)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
@@ -718,6 +738,8 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned
long mode_bits,
scm_weak_set_add_x (scm_i_port_weak_set, ret);
}
+ initialize_port_buffers (ret);
+
return ret;
}
@@ -817,7 +839,6 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
#define FUNC_NAME s_scm_close_port
{
scm_t_port_internal *pti;
- int rv;
port = SCM_COERCE_OUTPORT (port);
@@ -825,6 +846,10 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
if (SCM_CLOSEDP (port))
return SCM_BOOL_F;
+ /* May throw an exception. */
+ if (SCM_OUTPUT_PORT_P (port))
+ scm_flush (port);
+
pti = SCM_PORT_GET_INTERNAL (port);
SCM_CLR_PORT_OPEN_FLAG (port);
@@ -1018,7 +1043,7 @@ looking_at_bytes (SCM port, const unsigned char *bytes,
int len)
while (i < len && scm_peek_byte_or_eof_unlocked (port) == bytes[i])
{
- pt->read_pos++;
+ pt->read_buf->cur++;
i++;
}
scm_i_unget_bytes_unlocked (bytes, i, port);
@@ -1407,55 +1432,38 @@ scm_peek_byte_or_eof (SCM port)
return ret;
}
-/* scm_c_read
- *
- * Used by an application to read arbitrary number of bytes from an
- * SCM port. Same semantics as libc read, except that scm_c_read only
- * returns less than SIZE bytes if at end-of-file.
- *
- * Warning: Doesn't update port line and column counts! */
-
-/* This structure, and the following swap_buffer function, are used
- for temporarily swapping a port's own read buffer, and the buffer
- that the caller of scm_c_read provides. */
-struct port_and_swap_buffer
-{
- scm_t_port *pt;
- unsigned char *buffer;
- size_t size;
-};
-
+/* scm_i_read_unlocked is used internally to add bytes to the given port
+ buffer. If the number of available bytes in the buffer does not
+ increase after a call to scm_i_read_unlocked, that indicates EOF. */
static void
-swap_buffer (void *data)
+scm_i_read_unlocked (SCM port, scm_t_port_buffer *buf)
{
- struct port_and_swap_buffer *psb = (struct port_and_swap_buffer *) data;
- unsigned char *old_buf = psb->pt->read_buf;
- size_t old_size = psb->pt->read_buf_size;
+ size_t prev_end = buf->end;
+ assert (buf->end < buf->size);
- /* Make the port use (buffer, size) from the struct. */
- psb->pt->read_pos = psb->pt->read_buf = psb->pt->read_end = psb->buffer;
- psb->pt->read_buf_size = psb->size;
-
- /* Save the port's old (buffer, size) in the struct. */
- psb->buffer = old_buf;
- psb->size = old_size;
+ SCM_PORT_DESCRIPTOR (port)->read (port, buf);
+ buf->has_eof = buf->end == prev_end;
}
-static int scm_i_fill_input_unlocked (SCM port);
-
+/* scm_c_read
+ *
+ * Used by an application to read arbitrary number of bytes from an SCM
+ * port. Same semantics as libc read, except that scm_c_read only
+ * returns less than SIZE bytes if at end-of-file.
+ *
+ * Warning: Doesn't update port line and column counts! */
size_t
scm_c_read_unlocked (SCM port, void *buffer, size_t size)
#define FUNC_NAME "scm_c_read"
{
scm_t_port *pt;
- scm_t_port_internal *pti;
- size_t n_read = 0, n_available;
- struct port_and_swap_buffer psb;
+ scm_t_port_buffer *read_buf;
+ scm_t_port_buffer dst_buf = { buffer, 0, 0, size, 0, NULL };
SCM_VALIDATE_OPINPORT (1, port);
pt = SCM_PTAB_ENTRY (port);
- pti = SCM_PORT_GET_INTERNAL (port);
+ read_buf = pt->read_buf;
if (pt->rw_random)
{
@@ -1465,89 +1473,45 @@ scm_c_read_unlocked (SCM port, void *buffer, size_t
size)
}
/* Take bytes first from the port's read buffer. */
- if (pt->read_pos < pt->read_end)
- {
- n_available = min (size, pt->read_end - pt->read_pos);
- memcpy (buffer, pt->read_pos, n_available);
- buffer = (char *) buffer + n_available;
- pt->read_pos += n_available;
- n_read += n_available;
- size -= n_available;
- }
-
- /* Avoid the scm_dynwind_* costs if we now have enough data. */
- if (size == 0)
- return n_read;
-
- /* Now we will call scm_i_fill_input_unlocked repeatedly until we have
- read the requested number of bytes. (Note that a single
- scm_i_fill_input_unlocked call does not guarantee to fill the whole
- of the port's read buffer.) */
- if (pt->read_buf_size <= 1
- && pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1)
- {
- /* The port that we are reading from is unbuffered - i.e. does not
- have its own persistent buffer - but we have a buffer, provided
- by our caller, that is the right size for the data that is
- wanted. For the following scm_i_fill_input_unlocked calls,
- therefore, we use the buffer in hand as the port's read buffer.
-
- We need to make sure that the port's normal (1 byte) buffer is
- reinstated in case one of the scm_i_fill_input_unlocked ()
- calls throws an exception; we use the scm_dynwind_* API to
- achieve that.
-
- A consequence of this optimization is that the fill_input
- functions can't unget characters. That'll push data to the
- pushback buffer instead of this psb buffer. */
-#if SCM_DEBUG == 1
- unsigned char *pback = pt->putback_buf;
-#endif
- psb.pt = pt;
- psb.buffer = buffer;
- psb.size = size;
- scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
- scm_dynwind_rewind_handler (swap_buffer, &psb, SCM_F_WIND_EXPLICITLY);
- scm_dynwind_unwind_handler (swap_buffer, &psb, SCM_F_WIND_EXPLICITLY);
-
- /* Call scm_i_fill_input_unlocked until we have all the bytes that
- we need, or we hit EOF. */
- while (pt->read_buf_size && (scm_i_fill_input_unlocked (port) != EOF))
- {
- pt->read_buf_size -= (pt->read_end - pt->read_pos);
- pt->read_pos = pt->read_buf = pt->read_end;
- }
-#if SCM_DEBUG == 1
- if (pback != pt->putback_buf
- || pt->read_buf - (unsigned char *) buffer < 0)
- scm_misc_error (FUNC_NAME,
- "scm_c_read must not call a fill function that pushes "
- "back characters onto an unbuffered port", SCM_EOL);
-#endif
- n_read += pt->read_buf - (unsigned char *) buffer;
-
- /* Reinstate the port's normal buffer. */
- scm_dynwind_end ();
- }
- else
- {
- /* The port has its own buffer. It is important that we use it,
- even if it happens to be smaller than our caller's buffer, so
- that a custom port implementation's entry points (in
- particular, fill_input) can rely on the buffer always being
- the same as they first set up. */
- while (size && (scm_i_fill_input_unlocked (port) != EOF))
- {
- n_available = min (size, pt->read_end - pt->read_pos);
- memcpy (buffer, pt->read_pos, n_available);
- buffer = (char *) buffer + n_available;
- pt->read_pos += n_available;
- n_read += n_available;
- size -= n_available;
- }
- }
+ if (read_buf->cur < read_buf->end)
+ {
+ size_t to_read = dst_buf.size - dst_buf.end;
+ to_read = min (to_read, read_buf->end - read_buf->cur);
+ memcpy (dst_buf.buf + dst_buf.end, read_buf->buf + read_buf->cur,
+ to_read);
+ dst_buf.end += to_read;
+ read_buf->cur += to_read;
+ }
+
+ while (dst_buf.end < dst_buf.size)
+ /* If the read buffering is larger than our read size, buffer the
+ read. Otherwise read into our buffer directly. */
+ if (dst_buf.size - dst_buf.end < pt->read_buffering)
+ {
+ size_t to_read = dst_buf.size - dst_buf.end;
+ read_buf = scm_fill_input_unlocked (port);
+ if (to_read > read_buf->end - read_buf->cur)
+ to_read = read_buf->end - read_buf->cur;
+ if (to_read == 0)
+ {
+ /* Consider that we've read off this EOF. */
+ read_buf->has_eof = 0;
+ break;
+ }
+ memcpy (dst_buf.buf + dst_buf.end,
+ read_buf->buf + read_buf->cur,
+ to_read);
+ read_buf->cur += to_read;
+ dst_buf.end += to_read;
+ }
+ else
+ {
+ scm_i_read_unlocked (port, &dst_buf);
+ if (dst_buf.has_eof)
+ break;
+ }
- return n_read;
+ return dst_buf.end;
}
#undef FUNC_NAME
@@ -1643,7 +1607,7 @@ get_utf8_codepoint (SCM port, scm_t_wchar *codepoint,
if (SCM_UNLIKELY ((b) == EOF)) \
goto invalid_seq
#define CONSUME_PEEKED_BYTE() \
- pt->read_pos++
+ pt->read_buf->cur++
int byte;
scm_t_port *pt;
@@ -1979,88 +1943,58 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
static void
-scm_i_unget_bytes_unlocked (const unsigned char *buf, size_t len, SCM port)
+scm_i_unget_bytes_unlocked (const scm_t_uint8 *buf, size_t len, SCM port)
#define FUNC_NAME "scm_unget_bytes"
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
- size_t old_len, new_len;
+ scm_t_port_buffer *read_buf = pt->read_buf;
if (pt->rw_random)
{
if (pt->rw_active == SCM_PORT_WRITE)
- scm_flush (port);
+ scm_flush_unlocked (port);
pt->rw_active = SCM_PORT_READ;
}
- scm_i_clear_pending_eof (port);
-
- if (pt->read_buf != pt->putback_buf)
- /* switch to the put-back buffer. */
+ if (read_buf->cur < len)
{
- if (pt->putback_buf == NULL)
- {
- pt->putback_buf_size = (len > SCM_INITIAL_PUTBACK_BUF_SIZE
- ? len : SCM_INITIAL_PUTBACK_BUF_SIZE);
- pt->putback_buf
- = (unsigned char *) scm_gc_malloc_pointerless
- (pt->putback_buf_size, "putback buffer");
- }
-
- pt->saved_read_buf = pt->read_buf;
- pt->saved_read_pos = pt->read_pos;
- pt->saved_read_end = pt->read_end;
- pt->saved_read_buf_size = pt->read_buf_size;
-
- /* Put read_pos at the end of the buffer, so that ungets will not
- have to shift the buffer contents each time. */
- pt->read_buf = pt->putback_buf;
- pt->read_pos = pt->read_end = pt->putback_buf + pt->putback_buf_size;
- pt->read_buf_size = pt->putback_buf_size;
- }
-
- old_len = pt->read_end - pt->read_pos;
- new_len = old_len + len;
-
- if (new_len > pt->read_buf_size)
- /* The putback buffer needs to be enlarged. */
- {
- size_t new_buf_size;
- unsigned char *new_buf, *new_end, *new_pos;
-
- new_buf_size = pt->read_buf_size * 2;
- if (new_buf_size < new_len)
- new_buf_size = new_len;
-
- new_buf = (unsigned char *)
- scm_gc_malloc_pointerless (new_buf_size, "putback buffer");
-
- /* Put the bytes at the end of the buffer, so that future
- ungets won't need to shift the buffer. */
- new_end = new_buf + new_buf_size;
- new_pos = new_end - old_len;
- memcpy (new_pos, pt->read_pos, old_len);
-
- pt->read_buf = pt->putback_buf = new_buf;
- pt->read_pos = new_pos;
- pt->read_end = new_end;
- pt->read_buf_size = pt->putback_buf_size = new_buf_size;
- }
- else if (pt->read_buf + len < pt->read_pos)
- /* If needed, shift the existing buffer contents up.
- This should not happen unless some external code
- manipulates the putback buffer pointers. */
- {
- unsigned char *new_end = pt->read_buf + pt->read_buf_size;
- unsigned char *new_pos = new_end - old_len;
-
- memmove (new_pos, pt->read_pos, old_len);
- pt->read_pos = new_pos;
- pt->read_end = new_end;
+ /* The bytes don't fit directly in the read_buf. */
+ if (len <= read_buf->cur + (read_buf->size - read_buf->end))
+ {
+ /* But they would fit if we shift the not-yet-read bytes from
+ the read_buf right. Let's do that. */
+ size_t to_move = read_buf->end - read_buf->cur;
+
+ if (to_move > 0)
+ memmove (read_buf->buf + (read_buf->size - to_move),
+ read_buf->buf + read_buf->cur,
+ to_move);
+ read_buf->end = read_buf->size;
+ read_buf->cur = read_buf->end - to_move;
+ }
+ else
+ {
+ /* Bah, have to expand the read_buf for the putback. */
+ scm_t_port_buffer *new_buf;
+ size_t buffered = read_buf->end - read_buf->cur;
+ size_t size = read_buf->size;
+
+ while (size < len + buffered)
+ size *= 2;
+
+ new_buf = scm_c_make_port_buffer (size);
+ new_buf->end = new_buf->size;
+ new_buf->cur = new_buf->end - buffered;
+ new_buf->has_eof = read_buf->has_eof;
+ memcpy (new_buf->buf + new_buf->cur, read_buf->buf + read_buf->cur,
+ buffered);
+
+ pt->read_buf = read_buf = new_buf;
+ }
}
- /* Move read_pos back and copy the bytes there. */
- pt->read_pos -= len;
- memcpy (pt->read_buf + (pt->read_pos - pt->read_buf), buf, len);
+ read_buf->cur -= len;
+ memcpy (read_buf->buf + read_buf->cur, buf, len);
}
#undef FUNC_NAME
@@ -2297,17 +2231,6 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
/* Manipulating the buffers. */
-/* This routine does not take any locks, as it is usually called as part
- of a port implementation. */
-void
-scm_port_non_buffer (scm_t_port *pt)
-{
- pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
- pt->write_buf = pt->write_pos = &pt->shortbuf;
- pt->read_buf_size = pt->write_buf_size = 1;
- pt->write_end = pt->write_buf + pt->write_buf_size;
-}
-
SCM_SYMBOL (sym_none, "none");
SCM_SYMBOL (sym_line, "line");
SCM_SYMBOL (sym_block, "block");
@@ -2330,22 +2253,19 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
#define FUNC_NAME s_scm_setvbuf
{
long csize;
- size_t ndrained;
- char *drained = NULL;
scm_t_port *pt;
scm_t_ptob_descriptor *ptob;
scm_t_bits tag_word;
+ size_t read_buf_size, write_buf_size;
+ scm_t_port_buffer *saved_read_buf;
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
+ pt = SCM_PTAB_ENTRY (port);
ptob = SCM_PORT_DESCRIPTOR (port);
tag_word = SCM_CELL_WORD_0 (port) & ~(SCM_BUF0 | SCM_BUFLINE);
- if (ptob->setvbuf == NULL)
- scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
- "port that supports 'setvbuf'");
-
if (scm_is_eq (mode, sym_none))
{
tag_word |= SCM_BUF0;
@@ -2368,82 +2288,48 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
if (!SCM_UNBNDP (size) && csize < 0)
scm_out_of_range (FUNC_NAME, size);
- SCM_SET_CELL_WORD_0 (port, tag_word);
- pt = SCM_PTAB_ENTRY (port);
-
- if (SCM_INPUT_PORT_P (port))
+ if (csize >= 0)
+ read_buf_size = write_buf_size = csize;
+ else
{
- /* 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);
- }
+ read_buf_size = write_buf_size = default_buffer_size;
+ if (ptob->get_natural_buffer_sizes)
+ ptob->get_natural_buffer_sizes (port, &read_buf_size, &write_buf_size);
}
- else
- ndrained = 0;
+
+ /* Minimum buffer size is one byte. */
+ if (read_buf_size == 0)
+ read_buf_size = 1;
+ if (write_buf_size == 0)
+ write_buf_size = 1;
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;
- }
+ saved_read_buf = pt->read_buf;
- ptob->setvbuf (port, csize, csize);
+ SCM_SET_CELL_WORD_0 (port, tag_word);
+ pt->read_buffering = read_buf_size;
+ pt->read_buf = scm_c_make_port_buffer (read_buf_size);
+ pt->write_buf = scm_c_make_port_buffer (write_buf_size);
- if (ndrained > 0)
- /* Put DRAINED back to PORT. */
- scm_unget_bytes ((unsigned char *) drained, ndrained, port);
+ if (saved_read_buf && saved_read_buf->cur < saved_read_buf->end)
+ scm_unget_bytes (saved_read_buf->buf + saved_read_buf->cur,
+ saved_read_buf->end - saved_read_buf->cur,
+ port);
+
+ if (saved_read_buf)
+ pt->read_buf->has_eof = saved_read_buf->has_eof;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-/* this should only be called when the read buffer is empty. it
- tries to refill the read buffer. it returns the first char from
- the port, which is either EOF or *(pt->read_pos). */
-static int
-scm_i_fill_input_unlocked (SCM port)
-{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
- scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port);
-
- assert (pt->read_pos == pt->read_end);
-
- if (pti->pending_eof)
- {
- pti->pending_eof = 0;
- return EOF;
- }
-
- if (pt->read_buf == pt->putback_buf)
- {
- /* finished reading put-back chars. */
- 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_pos < pt->read_end)
- return *(pt->read_pos);
- }
- return SCM_PORT_DESCRIPTOR (port)->fill_input (port);
-}
-
-int
+scm_t_port_buffer*
scm_fill_input (SCM port)
{
scm_i_pthread_mutex_t *lock;
- int ret;
+ scm_t_port_buffer *ret;
scm_c_lock_port (port, &lock);
ret = scm_fill_input_unlocked (port);
@@ -2453,85 +2339,19 @@ scm_fill_input (SCM port)
return ret;
}
-/* Slow-path fallback for 'scm_get_byte_or_eof_unlocked' */
-int
-scm_slow_get_byte_or_eof_unlocked (SCM port)
-{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (pt->rw_random)
- {
- if (pt->rw_active == SCM_PORT_WRITE)
- scm_flush_unlocked (port);
- pt->rw_active = SCM_PORT_READ;
- }
-
- if (pt->read_pos >= pt->read_end)
- {
- if (SCM_UNLIKELY (scm_i_fill_input_unlocked (port) == EOF))
- return EOF;
- }
-
- return *pt->read_pos++;
-}
-
-/* Slow-path fallback for 'scm_peek_byte_or_eof_unlocked' */
-int
-scm_slow_peek_byte_or_eof_unlocked (SCM port)
-{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (pt->rw_random)
- {
- if (pt->rw_active == SCM_PORT_WRITE)
- scm_flush_unlocked (port);
- pt->rw_active = SCM_PORT_READ;
- }
-
- if (pt->read_pos >= pt->read_end)
- {
- if (SCM_UNLIKELY (scm_i_fill_input_unlocked (port) == EOF))
- {
- scm_i_set_pending_eof (port);
- return EOF;
- }
- }
-
- return *pt->read_pos;
-}
-
-/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
- into memory starting at DEST. Return the number of bytes moved.
- PORT's line/column numbers are left unchanged. */
+/* Move up to READ_LEN bytes from PORT's read buffer into memory
+ starting at DEST. Return the number of bytes moved. PORT's
+ line/column numbers are left unchanged. */
size_t
scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
- size_t bytes_read = 0;
- size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
+ scm_t_port_buffer *read_buf = pt->read_buf;
+ size_t count = min (read_buf->end - read_buf->cur, read_len);
- if (from_buf > 0)
- {
- memcpy (dest, pt->read_pos, from_buf);
- pt->read_pos += from_buf;
- bytes_read += from_buf;
- read_len -= from_buf;
- dest += from_buf;
- }
-
- /* if putback was active, try the real input buffer too. */
- if (pt->read_buf == pt->putback_buf)
- {
- from_buf = min (pt->saved_read_end - pt->saved_read_pos, read_len);
- if (from_buf > 0)
- {
- memcpy (dest, pt->saved_read_pos, from_buf);
- pt->saved_read_pos += from_buf;
- bytes_read += from_buf;
- }
- }
-
- return bytes_read;
+ memcpy (dest, read_buf->buf + read_buf->cur, count);
+ read_buf->cur += count;
+ return count;
}
/* Clear a port's read buffers, returning the contents. */
@@ -2553,21 +2373,21 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
#define FUNC_NAME s_scm_drain_input
{
SCM result;
- char *data;
scm_t_port *pt;
+ scm_t_port_buffer *read_buf;
long count;
SCM_VALIDATE_OPINPORT (1, port);
pt = SCM_PTAB_ENTRY (port);
+ read_buf = pt->read_buf;
- count = pt->read_end - pt->read_pos;
- if (pt->read_buf == pt->putback_buf)
- count += pt->saved_read_end - pt->saved_read_pos;
+ count = read_buf->end - read_buf->cur;
if (count)
{
- result = scm_i_make_string (count, &data, 0);
- scm_take_from_input_buffers (port, data, count);
+ scm_t_uint8 *ptr = read_buf->buf + read_buf->cur;
+ result = scm_from_port_stringn ((char *) ptr, count, port);
+ read_buf->cur = read_buf->end;
}
else
result = scm_nullstr;
@@ -2579,22 +2399,19 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
void
scm_end_input_unlocked (SCM port)
{
- long offset;
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_port *pt;
+ scm_t_port_buffer *buf;
+ scm_t_off offset;
- scm_i_clear_pending_eof (port);
- if (pt->read_buf == pt->putback_buf)
- {
- offset = pt->read_end - pt->read_pos;
- 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;
- }
- else
- offset = 0;
+ pt = SCM_PTAB_ENTRY (port);
+ buf = SCM_PTAB_ENTRY (port)->read_buf;
+ offset = buf->cur - buf->end;
+
+ assert (pt->rw_random);
- SCM_PORT_DESCRIPTOR (port)->end_input (port, offset);
+ buf->end = buf->cur = 0;
+ if (offset != 0)
+ SCM_PORT_DESCRIPTOR (port)->seek (port, offset, SEEK_CUR);
pt->rw_active = SCM_PORT_NEITHER;
}
@@ -2633,7 +2450,10 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
void
scm_flush_unlocked (SCM port)
{
- SCM_PORT_DESCRIPTOR (port)->flush (port);
+ scm_t_port_buffer *buf = SCM_PTAB_ENTRY (port)->write_buf;
+ if (buf->cur < buf->end)
+ SCM_PORT_DESCRIPTOR (port)->write (port, buf);
+ buf->cur = buf->end = 0;
SCM_PTAB_ENTRY (port)->rw_active = SCM_PORT_NEITHER;
}
@@ -2647,10 +2467,32 @@ scm_flush (SCM port)
scm_i_pthread_mutex_unlock (lock);
}
-int
+scm_t_port_buffer *
scm_fill_input_unlocked (SCM port)
{
- return scm_i_fill_input_unlocked (port);
+ scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_port_buffer *read_buf = pt->read_buf;
+
+ if (read_buf->cur < read_buf->end || read_buf->has_eof)
+ return read_buf;
+
+ if (pt->rw_random)
+ {
+ if (pt->rw_active == SCM_PORT_WRITE)
+ scm_flush_unlocked (pt->port);
+ pt->rw_active = SCM_PORT_READ;
+ }
+
+ /* It could be that putback caused us to enlarge the buffer; now that
+ we've read all the bytes we need to shrink it again. */
+ if (read_buf->size != pt->read_buffering)
+ read_buf = pt->read_buf = scm_c_make_port_buffer (pt->read_buffering);
+ else
+ read_buf->cur = read_buf->end = 0;
+
+ scm_i_read_unlocked (port, read_buf);
+
+ return read_buf;
}
@@ -2692,12 +2534,14 @@ scm_c_write_unlocked (SCM port, const void *ptr, size_t
size)
#define FUNC_NAME "scm_c_write"
{
scm_t_port *pt;
+ scm_t_port_buffer *write_buf;
scm_t_ptob_descriptor *ptob;
SCM_VALIDATE_OPOUTPORT (1, port);
pt = SCM_PTAB_ENTRY (port);
ptob = SCM_PORT_DESCRIPTOR (port);
+ write_buf = pt->write_buf;
if (pt->rw_random)
{
@@ -2706,7 +2550,49 @@ scm_c_write_unlocked (SCM port, const void *ptr, size_t
size)
pt->rw_active = SCM_PORT_WRITE;
}
- ptob->write (port, ptr, size);
+ if (size < write_buf->size)
+ {
+ /* Make it so that write_buf->end is only nonzero if there are
+ buffered bytes already. */
+ if (write_buf->cur == write_buf->end)
+ write_buf->cur = write_buf->end = 0;
+
+ /* We buffer writes that are smaller in size than the write
+ buffer. If the buffer is too full to hold the new data, we
+ flush it beforehand. Otherwise it could be that the buffer is
+ full after filling it with the new data; if that's the case, we
+ flush then instead. */
+ if (write_buf->end + size > write_buf->size)
+ {
+ ptob->write (port, write_buf);
+ write_buf->cur = write_buf->end = 0;
+ }
+
+ memcpy (write_buf->buf + write_buf->end, ptr, size);
+ write_buf->end += size;
+
+ if (write_buf->end == write_buf->size)
+ {
+ ptob->write (port, write_buf);
+ write_buf->cur = write_buf->end = 0;
+ }
+ }
+ else
+ {
+ /* Our write would overflow the buffer. Flush buffered bytes (if
+ needed), then write our bytes with just one syscall. */
+
+ scm_t_port_buffer ad_hoc_buf =
+ { (scm_t_uint8 *) ptr, 0, size, size, 0, NULL };
+
+ if (write_buf->cur < write_buf->end)
+ {
+ ptob->write (port, write_buf);
+ write_buf->cur = write_buf->end = 0;
+ }
+
+ ptob->write (port, &ad_hoc_buf);
+ }
}
#undef FUNC_NAME
@@ -2784,6 +2670,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
#define FUNC_NAME s_scm_char_ready_p
{
scm_t_port *pt;
+ scm_t_port_buffer *read_buf;
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
@@ -2792,20 +2679,17 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
SCM_VALIDATE_OPINPORT (1, port);
pt = SCM_PTAB_ENTRY (port);
+ read_buf = pt->read_buf;
- /* if the current read buffer is filled, or the
- last pushed-back char has been read and the saved buffer is
- filled, result is true. */
- if (pt->read_pos < pt->read_end
- || (pt->read_buf == pt->putback_buf
- && pt->saved_read_pos < pt->saved_read_end))
+ if (read_buf->cur < read_buf->end || read_buf->has_eof)
+ /* FIXME: Verify that a whole character is available? */
return SCM_BOOL_T;
else
{
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
if (ptob->input_waiting)
- return scm_from_bool(ptob->input_waiting (port));
+ return scm_from_bool (ptob->input_waiting (port));
else
return SCM_BOOL_T;
}
@@ -2969,10 +2853,10 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
SCM_MISC_ERROR ("port is not truncatable", SCM_EOL);
scm_i_clear_pending_eof (object);
- if (pt->rw_active == SCM_PORT_READ)
- scm_end_input_unlocked (object);
- else if (pt->rw_active == SCM_PORT_WRITE)
- scm_flush_unlocked (object);
+
+ if (SCM_INPUT_PORT_P (object))
+ scm_end_input_unlocked (object);
+ scm_flush_unlocked (object);
ptob->truncate (object, c_length);
rv = 0;
@@ -3198,28 +3082,20 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0,
0, 0,
scm_t_bits scm_tc16_void_port = 0;
-static int fill_input_void_port (SCM port SCM_UNUSED)
+static void
+void_port_read (SCM port, scm_t_port_buffer *buf)
{
- return EOF;
}
static void
-write_void_port (SCM port SCM_UNUSED,
- const void *data SCM_UNUSED,
- size_t size SCM_UNUSED)
+void_port_write (SCM port, scm_t_port_buffer *buf)
{
}
static SCM
scm_i_void_port (long mode_bits)
{
- SCM ret;
-
- ret = scm_c_make_port (scm_tc16_void_port, mode_bits, 0);
-
- scm_port_non_buffer (SCM_PTAB_ENTRY (ret));
-
- return ret;
+ return scm_c_make_port (scm_tc16_void_port, mode_bits, 0);
}
SCM
@@ -3253,8 +3129,8 @@ scm_init_ports ()
scm_c_define ("SEEK_CUR", scm_from_int (SEEK_CUR));
scm_c_define ("SEEK_END", scm_from_int (SEEK_END));
- scm_tc16_void_port = scm_make_port_type ("void", fill_input_void_port,
- write_void_port);
+ scm_tc16_void_port = scm_make_port_type ("void", void_port_read,
+ void_port_write);
cur_inport_fluid = scm_make_fluid ();
cur_outport_fluid = scm_make_fluid ();
diff --git a/libguile/ports.h b/libguile/ports.h
index 0196753..80e3a67 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -39,8 +39,6 @@
-#define SCM_INITIAL_PUTBACK_BUF_SIZE 4
-
/* values for the rw_active flag. */
typedef enum scm_t_port_rw_active {
SCM_PORT_NEITHER = 0,
@@ -51,74 +49,94 @@ typedef enum scm_t_port_rw_active {
/* An internal-only structure defined in ports-internal.h. */
struct scm_port_internal;
+/* Port buffers.
+
+ It's important to avoid calling into the kernel too many times. For
+ that reason we buffer the input and output, using `scm_t_port_buffer'
+ objects. The bytes in a read buffer are laid out like this:
+
+ |already read | not yet | invalid
+ | data | read | data
+ readbuf: #vu8(|r r r r r r r|u u u u u|x x x x x|)
+ ^buf ^cur ^end ^size
+
+ Similarly for a write buffer:
+
+ |already written | not yet | invalid
+ | data | written | data
+ writebuf: #vu8(|w w w w w w w w |u u u u u|x x x x x|)
+ ^buf ^cur ^end ^size
+
+ We use a `scm_t_port_buffer' object for both purposes. Port buffers
+ are implemented as their own object so that they can be atomically
+ swapped in or out. */
+
+typedef struct
+{
+ /* Start of the buffer. Never changed. */
+ scm_t_uint8 *buf;
+
+ /* Offsets into the buffer. Invariant: cur <= end <= size. */
+ size_t cur;
+ size_t end;
+ size_t size;
+
+ /* For read buffers, flag indicating whether the last read() returned
+ zero bytes. Note that in the case of pushback, there could still
+ be bytes in the buffer, but that after any bytes are read off,
+ peek-u8 should still return EOF. */
+ int has_eof;
+
+ /* Heap object that keeps `buf' alive. */
+ void *holder;
+} scm_t_port_buffer;
+
+
/* C representation of a Scheme port. */
typedef struct
{
- SCM port; /* Link back to the port object. */
- scm_i_pthread_mutex_t *lock; /* A recursive lock for this port. */
+ /* Link back to the port object. */
+ SCM port;
+
+ /* A recursive lock for this port. */
+ scm_i_pthread_mutex_t *lock;
- /* pointer to internal-only port structure */
+ /* Pointer to internal-only port structure. */
struct scm_port_internal *internal;
- /* data for the underlying port implementation as a raw C value. */
+ /* Data for the underlying port implementation as a raw C value. */
scm_t_bits stream;
- SCM file_name; /* debugging support. */
- long line_number; /* debugging support. */
- int column_number; /* debugging support. */
-
- /* port buffers. the buffer(s) are set up for all ports.
- in the case of string ports, the buffer is the string itself.
- in the case of unbuffered file ports, the buffer is a
- single char: shortbuf. */
-
- /* this buffer is filled from read_buf to read_end using the ptob
- buffer_fill. then input requests are taken from read_pos until
- it reaches read_end. */
-
- unsigned char *read_buf; /* buffer start. */
- const unsigned char *read_pos;/* the next unread char. */
- unsigned char *read_end; /* pointer to last buffered char + 1. */
- scm_t_off read_buf_size; /* size of the buffer. */
-
- /* when chars are put back into the buffer, e.g., using peek-char or
- unread-string, the read-buffer pointers are switched to cbuf.
- the original pointers are saved here and restored when the put-back
- chars have been consumed. */
- unsigned char *saved_read_buf;
- const unsigned char *saved_read_pos;
- unsigned char *saved_read_end;
- scm_t_off saved_read_buf_size;
-
- /* write requests are saved into this buffer at write_pos until it
- reaches write_buf + write_buf_size, then the ptob flush is
- called. */
-
- unsigned char *write_buf; /* buffer start. */
- unsigned char *write_pos; /* pointer to last buffered char + 1. */
- unsigned char *write_end; /* pointer to end of buffer + 1. */
- scm_t_off write_buf_size; /* size of the buffer. */
-
- unsigned char shortbuf; /* buffer for "unbuffered" streams. */
-
- int rw_random; /* true if the port is random access.
- implies that the buffers must be
- flushed before switching between
- reading and writing, seeking, etc. */
-
- scm_t_port_rw_active rw_active; /* for random access ports,
- indicates which of the buffers
- is currently in use. can be
- SCM_PORT_WRITE, SCM_PORT_READ,
- or SCM_PORT_NEITHER. */
-
-
- /* a buffer for un-read chars and strings. */
- unsigned char *putback_buf;
- size_t putback_buf_size; /* allocated size of putback_buf. */
-
- /* Character encoding support */
+ /* Source location information. */
+ SCM file_name;
+ long line_number;
+ int column_number;
+
+ /* Port buffers. */
+ scm_t_port_buffer *read_buf;
+ scm_t_port_buffer *write_buf;
+
+ /* All ports have read and write buffers; an unbuffered port simply
+ has a one-byte buffer. However unreading bytes can expand the read
+ buffer, but that doesn't mean that we want to increase the input
+ buffering. For that reason `read_buffering' is a separate
+ indication of how many characters to buffer on the read side.
+ There isn't a write_buf_size because there isn't an
+ `unwrite-byte'. */
+ size_t read_buffering;
+
+ /* True if the port is random access. Implies that the buffers must
+ be flushed before switching between reading and writing, seeking,
+ and so on. */
+ int rw_random;
+
+ /* For random access ports, indicates which of the buffers is
+ currently in use. Can be SCM_PORT_WRITE, SCM_PORT_READ, or
+ SCM_PORT_NEITHER. */
+ scm_t_port_rw_active rw_active;
+
+ /* Character encoding support. */
char *encoding;
scm_t_string_failed_conversion_handler ilseq_handler;
} scm_t_port;
@@ -127,8 +145,6 @@ typedef struct
SCM_INTERNAL SCM scm_i_port_weak_set;
-#define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)
-
#define SCM_EOF_OBJECT_P(x) (scm_is_eq ((x), SCM_EOF_VAL))
@@ -187,25 +203,19 @@ typedef struct scm_t_ptob_descriptor
{
char *name;
int (*print) (SCM exp, SCM port, scm_print_state *pstate);
+
+ void (*read) (SCM port, scm_t_port_buffer *dst);
+ void (*write) (SCM port, scm_t_port_buffer *src);
+ scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
void (*close) (SCM port);
- void (*write) (SCM port, const void *data, size_t size);
- void (*flush) (SCM port);
+ void (*get_natural_buffer_sizes) (SCM port, size_t *read_size,
+ size_t *write_size);
- void (*end_input) (SCM port, int offset);
- int (*fill_input) (SCM port);
int (*input_waiting) (SCM port);
- 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;
@@ -218,22 +228,16 @@ typedef struct scm_t_ptob_descriptor
SCM_INTERNAL long scm_c_num_port_types (void);
SCM_API scm_t_ptob_descriptor* scm_c_port_type_ref (long ptobnum);
SCM_API long scm_c_port_type_add_x (scm_t_ptob_descriptor *desc);
-SCM_API scm_t_bits scm_make_port_type (char *name,
- int (*fill_input) (SCM port),
- void (*write) (SCM port,
- const void *data,
- size_t size));
+SCM_API scm_t_bits scm_make_port_type
+ (char *name,
+ void (*read) (SCM port, scm_t_port_buffer *dst),
+ void (*write) (SCM port, scm_t_port_buffer *src));
SCM_API void scm_set_port_print (scm_t_bits tc,
int (*print) (SCM exp,
SCM port,
scm_print_state *pstate));
SCM_API void scm_set_port_close (scm_t_bits tc, void (*close) (SCM));
SCM_API void scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p);
-
-SCM_API void scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port));
-SCM_API void scm_set_port_end_input (scm_t_bits tc,
- void (*end_input) (SCM port,
- int offset));
SCM_API void scm_set_port_seek (scm_t_bits tc,
scm_t_off (*seek) (SCM port,
scm_t_off OFFSET,
@@ -242,8 +246,8 @@ 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, long, long));
+SCM_API void scm_set_port_get_natural_buffer_sizes
+ (scm_t_bits tc, void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *));
/* The input, output, error, and load ports. */
SCM_API SCM scm_current_input_port (void);
@@ -260,6 +264,9 @@ SCM_API void scm_dynwind_current_output_port (SCM port);
SCM_API void scm_dynwind_current_error_port (SCM port);
SCM_INTERNAL void scm_i_dynwind_current_load_port (SCM port);
+/* Port buffers. */
+SCM_INTERNAL scm_t_port_buffer *scm_c_make_port_buffer (size_t size);
+
/* Mode bits. */
SCM_INTERNAL long scm_i_mode_bits (SCM modes);
SCM_API long scm_mode_bits (char *modes);
@@ -334,10 +341,9 @@ 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 void scm_port_non_buffer (scm_t_port *pt);
SCM_API SCM scm_setvbuf (SCM port, SCM mode, SCM size);
-SCM_API int scm_fill_input (SCM port);
-SCM_API int scm_fill_input_unlocked (SCM port);
+SCM_API scm_t_port_buffer* scm_fill_input (SCM port);
+SCM_API scm_t_port_buffer* scm_fill_input_unlocked (SCM port);
SCM_INTERNAL size_t scm_take_from_input_buffers (SCM port, char *dest, size_t
read_len);
SCM_API SCM scm_drain_input (SCM port);
SCM_API void scm_end_input (SCM port);
@@ -422,13 +428,19 @@ scm_c_try_lock_port (SCM port, scm_i_pthread_mutex_t
**lock)
SCM_INLINE_IMPLEMENTATION int
scm_get_byte_or_eof_unlocked (SCM port)
{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_port_buffer *buf = SCM_PTAB_ENTRY (port)->read_buf;
- if (SCM_LIKELY ((pt->rw_active == SCM_PORT_READ || !pt->rw_random)
- && pt->read_pos < pt->read_end))
- return *pt->read_pos++;
- else
- return scm_slow_get_byte_or_eof_unlocked (port);
+ if (SCM_LIKELY (buf->cur < buf->end))
+ return buf->buf[buf->cur++];
+
+ buf = scm_fill_input_unlocked (port);
+ if (buf->cur < buf->end)
+ return buf->buf[buf->cur++];
+
+ /* The next peek or get should cause the read() function to be called
+ to see if we still have EOF. */
+ buf->has_eof = 0;
+ return EOF;
}
/* Like `scm_get_byte_or_eof' but does not change PORT's `read_pos'. */
@@ -436,12 +448,16 @@ SCM_INLINE_IMPLEMENTATION int
scm_peek_byte_or_eof_unlocked (SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_port_buffer *buf = pt->read_buf;
- if (SCM_LIKELY ((pt->rw_active == SCM_PORT_READ || !pt->rw_random)
- && pt->read_pos < pt->read_end))
- return *pt->read_pos;
- else
- return scm_slow_peek_byte_or_eof_unlocked (port);
+ if (SCM_LIKELY (buf->cur < buf->end))
+ return buf->buf[buf->cur];
+
+ buf = scm_fill_input_unlocked (port);
+ if (buf->cur < buf->end)
+ return buf->buf[buf->cur];
+
+ return EOF;
}
SCM_INLINE_IMPLEMENTATION void
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 9e12b5a..aa54a0e 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -78,87 +78,70 @@ SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
/* Bytevector input ports. */
static scm_t_bits bytevector_input_port_type = 0;
+struct bytevector_input_port {
+ SCM bytevector;
+ size_t pos;
+};
+
static inline SCM
make_bytevector_input_port (SCM bv)
{
- SCM port;
- char *c_bv;
- unsigned c_len;
- scm_t_port *c_port;
const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
+ struct bytevector_input_port *stream;
- port = scm_c_make_port_with_encoding (bytevector_input_port_type,
+ stream = scm_gc_typed_calloc (struct bytevector_input_port);
+ stream->bytevector = bv;
+ stream->pos = 0;
+ return scm_c_make_port_with_encoding (bytevector_input_port_type,
mode_bits,
NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR,
- SCM_UNPACK (bv));
-
- c_port = SCM_PTAB_ENTRY (port);
-
- /* Have the port directly access the bytevector. */
- c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
- c_len = SCM_BYTEVECTOR_LENGTH (bv);
-
- c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
- c_port->read_end = (unsigned char *) c_bv + c_len;
- c_port->read_buf_size = c_len;
-
- return port;
+ (scm_t_bits) stream);
}
-static int
-bytevector_input_port_fill_input (SCM port)
+static void
+bytevector_input_port_read (SCM port, scm_t_port_buffer *buf)
{
- int result;
- scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+ size_t count;
+ struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
- if (c_port->read_pos >= c_port->read_end)
- result = EOF;
- else
- result = (int) *c_port->read_pos;
+ if (stream->pos >= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
+ return;
- return result;
+ count = SCM_BYTEVECTOR_LENGTH (stream->bytevector) - stream->pos;
+ if (count > buf->size - buf->end)
+ count = buf->size - buf->end;
+
+ memcpy (buf->buf + buf->end,
+ SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
+ count);
+
+ buf->end += count;
+ stream->pos += count;
}
static scm_t_off
bytevector_input_port_seek (SCM port, scm_t_off offset, int whence)
#define FUNC_NAME "bytevector_input_port_seek"
{
- scm_t_off c_result = 0;
- scm_t_port *c_port = SCM_PTAB_ENTRY (port);
-
- switch (whence)
- {
- case SEEK_CUR:
- offset += c_port->read_pos - c_port->read_buf;
- /* Fall through. */
-
- case SEEK_SET:
- if (c_port->read_buf + offset <= c_port->read_end)
- {
- c_port->read_pos = c_port->read_buf + offset;
- c_result = offset;
- }
- else
- scm_out_of_range (FUNC_NAME, scm_from_int (offset));
- break;
-
- case SEEK_END:
- if (c_port->read_end - offset >= c_port->read_buf)
- {
- c_port->read_pos = c_port->read_end - offset;
- c_result = c_port->read_pos - c_port->read_buf;
- }
- else
- scm_out_of_range (FUNC_NAME, scm_from_int (offset));
- break;
+ struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
+ scm_t_off target;
+
+ if (whence == SEEK_CUR)
+ target = offset + stream->pos;
+ else if (whence == SEEK_SET)
+ target = offset;
+ else if (whence == SEEK_END)
+ target = offset + SCM_BYTEVECTOR_LENGTH (stream->bytevector);
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
- default:
- scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
- "invalid `seek' parameter");
- }
+ if (target >= 0 && target <= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
+ stream->pos = target;
+ else
+ scm_out_of_range (FUNC_NAME, scm_from_long (offset));
- return c_result;
+ return target;
}
#undef FUNC_NAME
@@ -169,7 +152,7 @@ initialize_bytevector_input_ports (void)
{
bytevector_input_port_type =
scm_make_port_type ("r6rs-bytevector-input-port",
- bytevector_input_port_fill_input,
+ bytevector_input_port_read,
NULL);
scm_set_port_seek (bytevector_input_port_type, bytevector_input_port_seek);
@@ -198,7 +181,6 @@ SCM_DEFINE (scm_open_bytevector_input_port,
output custom binary ports. */
struct custom_binary_port {
- SCM read_buffer;
SCM read;
SCM write;
SCM get_position;
@@ -274,154 +256,53 @@ custom_binary_port_close (SCM port)
static scm_t_bits custom_binary_input_port_type = 0;
-/* Initial size of the buffer embedded in custom binary input ports. */
-#define CUSTOM_BINARY_INPUT_PORT_BUFFER_SIZE 8192
-
-
-/* Set PORT's internal buffer according to READ_SIZE. */
-static void
-custom_binary_input_port_setvbuf (SCM port, long read_size, long write_size)
-{
- SCM bv;
- scm_t_port *pt;
- struct custom_binary_port *stream = (void *) SCM_STREAM (port);
-
- pt = SCM_PTAB_ENTRY (port);
- bv = stream->read_buffer;
-
- switch (read_size)
- {
- case 0:
- /* Unbuffered: keep using PORT's bytevector as the underlying
- buffer (it will also be used by future 'scm_c_read' calls.) */
- assert (SCM_BYTEVECTOR_LENGTH (bv) >= 1);
- pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
- 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);
- stream->read_buffer = 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_custom_binary_input_port (SCM read_proc, SCM get_position_proc,
SCM set_position_proc, SCM close_proc)
{
- SCM port, bv;
- char *c_bv;
- unsigned c_len;
- scm_t_port *c_port;
struct custom_binary_port *stream;
const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
- /* Use a bytevector as the underlying buffer. */
- c_len = CUSTOM_BINARY_INPUT_PORT_BUFFER_SIZE;
- bv = scm_c_make_bytevector (c_len);
- c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
-
stream = scm_gc_typed_calloc (struct custom_binary_port);
- stream->read_buffer = bv;
stream->read = read_proc;
stream->write = SCM_BOOL_F;
stream->get_position = get_position_proc;
stream->set_position_x = set_position_proc;
stream->close = close_proc;
- port = scm_c_make_port_with_encoding (custom_binary_input_port_type,
+ return scm_c_make_port_with_encoding (custom_binary_input_port_type,
mode_bits,
NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR,
(scm_t_bits) stream);
-
- c_port = SCM_PTAB_ENTRY (port);
-
- /* Have the port directly access the buffer (bytevector). */
- c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
- c_port->read_end = (unsigned char *) c_bv;
- c_port->read_buf_size = c_len;
-
- return port;
}
-static int
-custom_binary_input_port_fill_input (SCM port)
-#define FUNC_NAME "custom_binary_input_port_fill_input"
+static void
+custom_binary_input_port_read (SCM port, scm_t_port_buffer *buf)
+#define FUNC_NAME "custom_binary_input_port_read"
{
- int result;
- scm_t_port *c_port = SCM_PTAB_ENTRY (port);
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
-
- 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, octets;
-
- c_requested = c_port->read_buf_size;
-
- bv = stream->read_buffer;
- buffered =
- (c_port->read_buf == (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
-
- if (buffered)
- {
- /* Make sure the buffer isn't corrupt. Its size can be 1 when
- someone called 'setvbuf' with 'none. BV can be passed
- directly to READ_PROC. */
- assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv)
- || c_port->read_buf_size == 1);
- c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (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
- nbytevector for later reuse, in the hope that the application
- has regular access patterns. */
- stream->read_buffer = bv = scm_c_make_bytevector (c_requested);
- }
-
- octets = scm_call_3 (stream->read, bv, SCM_INUM0,
- scm_from_size_t (c_requested));
- c_octets = scm_to_size_t (octets);
- if (SCM_UNLIKELY (c_octets > c_requested))
- scm_out_of_range (FUNC_NAME, octets);
-
- 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 || c_requested == 0)
- result = (int) *c_port->read_pos;
- else
- result = EOF;
- }
- else
- result = (int) *c_port->read_pos;
-
- return result;
+ SCM bv, octets;
+ size_t c_octets;
+
+ /* FIXME: We need to make sure buf->buf is kept alive. If read_buf is
+ referenced from PORT, passing PORT as the parent will do it. But,
+ pushback could re-set PORT->read_buf, which would be a fail. But,
+ probably buf->buf is itself GC-allocated, so we can pack it
+ directly. But, perhaps it's not, as in scm_c_read(). In that
+ latter case we're kinda screwed and probably need to prevent
+ rewinding. But shouldn't we always prevent rewinding? And how can
+ we avoid allocating the bytevector at all? */
+ bv = scm_c_take_gc_bytevector ((signed char *) (buf->buf + buf->end),
+ buf->size - buf->end,
+ PTR2SCM (buf->buf));
+
+ octets = scm_call_3 (stream->read, bv, SCM_INUM0, scm_bytevector_length
(bv));
+ c_octets = scm_to_size_t (octets);
+ if (c_octets > scm_c_bytevector_length (bv))
+ scm_out_of_range (FUNC_NAME, octets);
+
+ buf->end += c_octets;
}
#undef FUNC_NAME
@@ -459,12 +340,10 @@ initialize_custom_binary_input_ports (void)
{
custom_binary_input_port_type =
scm_make_port_type ("r6rs-custom-binary-input-port",
- custom_binary_input_port_fill_input, NULL);
+ custom_binary_input_port_read, NULL);
scm_set_port_seek (custom_binary_input_port_type, custom_binary_port_seek);
scm_set_port_close (custom_binary_input_port_type, custom_binary_port_close);
- scm_set_port_setvbuf (custom_binary_input_port_type,
- custom_binary_input_port_setvbuf);
}
@@ -603,29 +482,20 @@ SCM_DEFINE (scm_get_bytevector_some,
"get-bytevector-some", 1, 0, 0,
"position to point just past these bytes.")
#define FUNC_NAME s_scm_get_bytevector_some
{
- scm_t_port *pt;
+ scm_t_port_buffer *buf;
size_t size;
SCM bv;
SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
- pt = SCM_PTAB_ENTRY (port);
-
- if (pt->rw_active == SCM_PORT_WRITE)
- scm_flush_unlocked (port);
- if (pt->rw_random)
- pt->rw_active = SCM_PORT_READ;
-
- if (pt->read_pos >= pt->read_end)
+ buf = scm_fill_input_unlocked (port);
+ if (buf->cur == buf->end)
{
- if (scm_fill_input_unlocked (port) == EOF)
- return SCM_EOF_VAL;
+ buf->has_eof = 0;
+ return SCM_EOF_VAL;
}
- size = pt->read_end - pt->read_pos;
- if (pt->read_buf == pt->putback_buf)
- size += pt->saved_read_end - pt->saved_read_pos;
-
+ size = buf->end - buf->cur;
bv = scm_c_make_bytevector (size);
scm_take_from_input_buffers
(port, (char *) SCM_BYTEVECTOR_CONTENTS (bv), size);
@@ -838,6 +708,10 @@ typedef struct
size_t len;
size_t pos;
char *buffer;
+
+ /* The get-bytevector procedure will flush this port, if it's
+ open. */
+ SCM port;
} scm_t_bytevector_output_port_buffer;
@@ -853,6 +727,7 @@ bytevector_output_port_buffer_init
(scm_t_bytevector_output_port_buffer *buf)
{
buf->total_len = buf->len = buf->pos = 0;
buf->buffer = NULL;
+ /* Don't clear the port. */
}
static inline void
@@ -882,7 +757,6 @@ static inline SCM
make_bytevector_output_port (void)
{
SCM port, proc;
- scm_t_port *c_port;
scm_t_bytevector_output_port_buffer *buf;
const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
@@ -895,31 +769,28 @@ make_bytevector_output_port (void)
NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR,
(scm_t_bits)buf);
+ buf->port = port;
- c_port = SCM_PTAB_ENTRY (port);
-
- c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
- c_port->write_buf_size = 0;
-
- /* Make the bytevector output port procedure. */
SCM_NEWSMOB (proc, bytevector_output_port_procedure, buf);
- return (scm_values (scm_list_2 (port, proc)));
+ return scm_values (scm_list_2 (port, proc));
}
-/* Write SIZE octets from DATA to PORT. */
+/* Write octets from WRITE_BUF to the backing store. */
static void
-bytevector_output_port_write (SCM port, const void *data, size_t size)
+bytevector_output_port_write (SCM port, scm_t_port_buffer *write_buf)
{
+ size_t count;
scm_t_bytevector_output_port_buffer *buf;
buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port);
+ count = write_buf->end - write_buf->cur;
- if (buf->pos + size > buf->total_len)
- bytevector_output_port_buffer_grow (buf, buf->pos + size);
+ if (buf->pos + count > buf->total_len)
+ bytevector_output_port_buffer_grow (buf, buf->pos + count);
- memcpy (buf->buffer + buf->pos, data, size);
- buf->pos += size;
+ memcpy (buf->buffer + buf->pos, write_buf->buf + write_buf->cur, count);
+ buf->pos += count;
buf->len = (buf->len > buf->pos) ? buf->len : buf->pos;
}
@@ -928,34 +799,25 @@ bytevector_output_port_seek (SCM port, scm_t_off offset,
int whence)
#define FUNC_NAME "bytevector_output_port_seek"
{
scm_t_bytevector_output_port_buffer *buf;
+ scm_t_off target;
buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port);
- switch (whence)
- {
- case SEEK_CUR:
- offset += (scm_t_off) buf->pos;
- /* Fall through. */
- case SEEK_SET:
- if (offset < 0 || (unsigned) offset > buf->len)
- scm_out_of_range (FUNC_NAME, scm_from_int (offset));
- else
- buf->pos = offset;
- break;
-
- case SEEK_END:
- if (offset < 0 || (unsigned) offset >= buf->len)
- scm_out_of_range (FUNC_NAME, scm_from_int (offset));
- else
- buf->pos = buf->len - (offset + 1);
- break;
+ if (whence == SEEK_CUR)
+ target = offset + buf->pos;
+ else if (whence == SEEK_SET)
+ target = offset;
+ else if (whence == SEEK_END)
+ target = offset + buf->len;
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
- default:
- scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
- "invalid `seek' parameter");
- }
+ if (target >= 0 && target <= buf->len)
+ buf->pos = target;
+ else
+ scm_out_of_range (FUNC_NAME, scm_from_long (offset));
- return buf->pos;
+ return target;
}
#undef FUNC_NAME
@@ -968,6 +830,9 @@ SCM_SMOB_APPLY (bytevector_output_port_procedure,
buf = (scm_t_bytevector_output_port_buffer *) SCM_SMOB_DATA (proc);
+ if (SCM_OPPORTP (buf->port))
+ scm_flush (buf->port);
+
result_buf = *buf;
bytevector_output_port_buffer_init (buf);
@@ -1026,70 +891,58 @@ static inline SCM
make_custom_binary_output_port (SCM write_proc, SCM get_position_proc,
SCM set_position_proc, SCM close_proc)
{
- SCM port;
- scm_t_port *c_port;
struct custom_binary_port *stream;
const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
- /* Store the various methods and bytevector in a vector. */
stream = scm_gc_typed_calloc (struct custom_binary_port);
-
- stream->read_buffer = SCM_BOOL_F;
stream->read = SCM_BOOL_F;
stream->write = write_proc;
stream->get_position = get_position_proc;
stream->set_position_x = set_position_proc;
stream->close = close_proc;
- port = scm_c_make_port_with_encoding (custom_binary_output_port_type,
+ return scm_c_make_port_with_encoding (custom_binary_output_port_type,
mode_bits,
NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR,
(scm_t_bits) stream);
-
- c_port = SCM_PTAB_ENTRY (port);
-
- /* Have the port directly access the buffer (bytevector). */
- c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
- c_port->write_buf_size = c_port->read_buf_size = 0;
-
- return port;
}
-/* Write SIZE octets from DATA to PORT. */
+/* Flush octets from BUF to the backing store. */
static void
-custom_binary_output_port_write (SCM port, const void *data, size_t size)
+custom_binary_output_port_write (SCM port, scm_t_port_buffer *buf)
#define FUNC_NAME "custom_binary_output_port_write"
{
- long int c_result;
- size_t c_written;
+ size_t size, written;
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
- SCM bv, result;
+ SCM bv;
- /* XXX: Allocating a new bytevector at each `write' call is inefficient,
- but necessary since (1) we don't control the lifetime of the buffer
- pointed to by DATA, and (2) the `write!' procedure could capture the
- bytevector it is passed. */
+ /* FIXME: If BUF is the same as PORT->write_buf, then the data is
+ GC-managed and we could avoid allocating a new bytevector backing
+ store. Otherwise we have to copy, as we do here. */
+ size = buf->end - buf->cur;
bv = scm_c_make_bytevector (size);
- memcpy (SCM_BYTEVECTOR_CONTENTS (bv), data, size);
+ memcpy (SCM_BYTEVECTOR_CONTENTS (bv), buf->buf + buf->cur, size);
/* Since the `write' procedure of Guile's ports has type `void', it must
try hard to write exactly SIZE bytes, regardless of how many bytes the
sink can handle. */
- for (c_written = 0;
- c_written < size;
- c_written += c_result)
+ written = 0;
+ while (written < size)
{
+ long int c_result;
+ SCM result;
+
result = scm_call_3 (stream->write, bv,
- scm_from_size_t (c_written),
- scm_from_size_t (size - c_written));
+ scm_from_size_t (written),
+ scm_from_size_t (size - written));
c_result = scm_to_long (result);
- if (SCM_UNLIKELY (c_result < 0
- || (size_t) c_result > (size - c_written)))
+ if (c_result < 0 || (size_t) c_result > (size - written))
scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
"R6RS custom binary output port `write!' "
"returned a incorrect integer");
+ written += c_result;
}
}
#undef FUNC_NAME
@@ -1141,118 +994,60 @@ initialize_custom_binary_output_ports (void)
static scm_t_bits transcoded_port_type = 0;
-#define TRANSCODED_PORT_INPUT_BUFFER_SIZE 4096
-
#define SCM_TRANSCODED_PORT_BINARY_PORT(_port) SCM_PACK (SCM_STREAM (_port))
static inline SCM
make_transcoded_port (SCM binary_port, unsigned long mode)
{
SCM port;
- scm_t_port *c_port;
const unsigned long mode_bits = SCM_OPN | mode;
port = scm_c_make_port (transcoded_port_type, mode_bits,
SCM_UNPACK (binary_port));
- if (SCM_INPUT_PORT_P (port))
- {
- c_port = SCM_PTAB_ENTRY (port);
- c_port->read_buf =
- scm_gc_malloc_pointerless (TRANSCODED_PORT_INPUT_BUFFER_SIZE,
- "port buffer");
- c_port->read_pos = c_port->read_end = c_port->read_buf;
- c_port->read_buf_size = TRANSCODED_PORT_INPUT_BUFFER_SIZE;
-
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
- }
-
return port;
}
static void
-transcoded_port_write (SCM port, const void *data, size_t size)
+transcoded_port_write (SCM port, scm_t_port_buffer *buf)
{
- scm_c_write_unlocked (SCM_TRANSCODED_PORT_BINARY_PORT (port), data, size);
+ SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
+ scm_c_write_unlocked (bport, buf->buf + buf->cur, buf->end - buf->cur);
}
-static int
-transcoded_port_fill_input (SCM port)
+static void
+transcoded_port_read (SCM port, scm_t_port_buffer *buf)
{
size_t count;
- scm_t_port *c_port = SCM_PTAB_ENTRY (port);
- SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
- scm_t_port *c_bport = SCM_PTAB_ENTRY (bport);
+ scm_t_port_buffer *bport_buf;
/* We can't use `scm_c_read' here, since it blocks until the whole
block has been read or EOF. */
- if (c_bport->rw_active == SCM_PORT_WRITE)
- scm_force_output (bport);
-
- if (c_bport->read_pos >= c_bport->read_end)
- scm_fill_input_unlocked (bport);
-
- count = c_bport->read_end - c_bport->read_pos;
- if (count > c_port->read_buf_size)
- count = c_port->read_buf_size;
-
- memcpy (c_port->read_buf, c_bport->read_pos, count);
- c_bport->read_pos += count;
-
- if (c_bport->rw_random)
- c_bport->rw_active = SCM_PORT_READ;
-
- if (count == 0)
- return EOF;
- else
- {
- c_port->read_pos = c_port->read_buf;
- c_port->read_end = c_port->read_buf + count;
- return *c_port->read_buf;
- }
-}
-
-static void
-transcoded_port_flush (SCM port)
-{
- SCM binary_port = SCM_TRANSCODED_PORT_BINARY_PORT (port);
- scm_t_port *c_port = SCM_PTAB_ENTRY (port);
- size_t count = c_port->write_pos - c_port->write_buf;
-
- /* As the runtime will try to flush all ports upon exit, we test for
- the underlying port still being open here. Otherwise, when you
- would explicitly close the underlying port and the transcoded port
- still had data outstanding, you'd get an exception on Guile exit.
-
- We just throw away the data when the underlying port is closed. */
-
- if (SCM_OPOUTPORTP (binary_port))
- scm_c_write_unlocked (binary_port, c_port->write_buf, count);
-
- c_port->write_pos = c_port->write_buf;
-
- if (SCM_OPOUTPORTP (binary_port))
- scm_force_output (binary_port);
+ bport_buf = scm_fill_input (SCM_TRANSCODED_PORT_BINARY_PORT (port));
+ /* Consume EOF from bport. */
+ bport_buf->has_eof = 0;
+ count = bport_buf->end - bport_buf->cur;
+ if (count > buf->size - buf->end)
+ count = buf->size - buf->end;
+
+ memcpy (buf->buf + buf->end, bport_buf->buf + bport_buf->cur, count);
+ bport_buf->cur += count;
+ buf->end += count;
}
static void
transcoded_port_close (SCM port)
{
- SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
- if (SCM_OUTPUT_PORT_P (port))
- transcoded_port_flush (port);
- scm_close_port (bport);
+ scm_close_port (SCM_TRANSCODED_PORT_BINARY_PORT (port));
}
static inline void
initialize_transcoded_ports (void)
{
transcoded_port_type =
- scm_make_port_type ("r6rs-transcoded-port", transcoded_port_fill_input,
+ scm_make_port_type ("r6rs-transcoded-port", transcoded_port_read,
transcoded_port_write);
-
- scm_set_port_flush (transcoded_port_type, transcoded_port_flush);
scm_set_port_close (transcoded_port_type, transcoded_port_close);
scm_set_port_needs_close_on_gc (transcoded_port_type, 1);
}
diff --git a/libguile/read.c b/libguile/read.c
index 346bcc9..27cb094 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -2057,6 +2057,7 @@ char *
scm_i_scan_for_encoding (SCM port)
{
scm_t_port *pt;
+ scm_t_port_buffer *buf;
char header[SCM_ENCODING_SEARCH_SIZE+1];
size_t bytes_read, encoding_length, i;
char *encoding = NULL;
@@ -2064,6 +2065,7 @@ scm_i_scan_for_encoding (SCM port)
int in_comment;
pt = SCM_PTAB_ENTRY (port);
+ buf = pt->read_buf;
if (pt->rw_random)
{
@@ -2072,13 +2074,11 @@ scm_i_scan_for_encoding (SCM port)
pt->rw_active = SCM_PORT_READ;
}
- if (pt->read_pos == pt->read_end)
+ if (buf->cur == buf->end)
{
/* We can use the read buffer, and thus avoid a seek. */
- if (scm_fill_input_unlocked (port) == EOF)
- return NULL;
-
- bytes_read = pt->read_end - pt->read_pos;
+ buf = scm_fill_input_unlocked (port);
+ bytes_read = buf->end - buf->cur;
if (bytes_read > SCM_ENCODING_SEARCH_SIZE)
bytes_read = SCM_ENCODING_SEARCH_SIZE;
@@ -2086,7 +2086,7 @@ scm_i_scan_for_encoding (SCM port)
/* An unbuffered port -- don't scan. */
return NULL;
- memcpy (header, pt->read_pos, bytes_read);
+ memcpy (header, buf->buf + buf->cur, bytes_read);
header[bytes_read] = '\0';
}
else
diff --git a/libguile/rw.c b/libguile/rw.c
index 75c280b..9bd2320 100644
--- a/libguile/rw.c
+++ b/libguile/rw.c
@@ -231,22 +231,21 @@ SCM_DEFINE (scm_write_string_partial,
"write-string/partial", 1, 3, 0,
{
SCM port = (SCM_UNBNDP (port_or_fdes)?
scm_current_output_port () : port_or_fdes);
- scm_t_port *pt;
- scm_t_off space;
+ scm_t_port_buffer *write_buf;
SCM_VALIDATE_OPFPORT (2, port);
SCM_VALIDATE_OUTPUT_PORT (2, port);
- pt = SCM_PTAB_ENTRY (port);
- /* filling the last character in the buffer would require a flush. */
- space = pt->write_end - pt->write_pos - 1;
- if (space >= write_len)
+ write_buf = SCM_PTAB_ENTRY (port)->write_buf;
+
+ /* Filling the last character in the buffer would require a
+ flush. */
+ if (write_len < write_buf->size - write_buf->end)
{
- memcpy (pt->write_pos, src, write_len);
- pt->write_pos += write_len;
+ scm_c_write_unlocked (port, src, write_len);
return scm_from_long (write_len);
}
- if (pt->write_pos > pt->write_buf)
- scm_flush_unlocked (port);
+
+ scm_flush_unlocked (port);
fdes = SCM_FPORT_FDES (port);
}
{
diff --git a/libguile/strports.c b/libguile/strports.c
index 064e2f0..6ad7d18 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -52,171 +52,90 @@
*
*/
-/* NOTES:
-
- write_buf/write_end point to the ends of the allocated bytevector.
- read_buf/read_end point to the part of the bytevector which has been
- written to. read_pos and write_pos are always equal.
-
- ENHANCE-ME - output blocks:
-
- The current code keeps an output string as a single block. That means
- when the size is increased the entire old contents must be copied. It'd
- be more efficient to begin a new block when the old one is full, so
- there's no re-copying of previous data.
-
- To make seeking efficient, keeping the pieces in a vector might be best,
- though appending is probably the most common operation. The size of each
- block could be progressively increased, so the bigger the string the
- bigger the blocks.
-
- When `get-output-string' is called the blocks have to be coalesced into a
- string, the result could be kept as a single big block. If blocks were
- strings then `get-output-string' could notice when there's just one and
- return that with a copy-on-write (though repeated calls to
- `get-output-string' are probably unlikely).
-
- Another possibility would be to extend the port mechanism to let SCM
- strings come through directly from `display' and friends. That way if a
- big string is written it can be kept as a copy-on-write, saving time
- copying and maybe saving some space. */
-
-
scm_t_bits scm_tc16_strport;
+struct string_port {
+ SCM bytevector;
+ size_t pos;
+ size_t len;
+};
-static int
-st_fill_input (SCM port)
-{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (pt->read_pos >= pt->read_end)
- return EOF;
- else
- return *pt->read_pos;
-}
-
-/* Change the size of a port's bytevector to NEW_SIZE. This doesn't
- change `read_buf_size'. */
static void
-st_resize_port (scm_t_port *pt, scm_t_off new_size)
+string_port_read (SCM port, scm_t_port_buffer *dst)
{
- SCM old_stream = SCM_PACK (pt->stream);
- const signed char *src = SCM_BYTEVECTOR_CONTENTS (old_stream);
- SCM new_stream = scm_c_make_bytevector (new_size);
- signed char *dst = SCM_BYTEVECTOR_CONTENTS (new_stream);
- unsigned long int old_size = SCM_BYTEVECTOR_LENGTH (old_stream);
- unsigned long int min_size = min (old_size, new_size);
-
- scm_t_off offset = pt->write_pos - pt->write_buf;
-
- pt->write_buf_size = new_size;
+ size_t count;
+ struct string_port *stream = (void *) SCM_STREAM (port);
- memcpy (dst, src, min_size);
+ if (stream->pos >= stream->len)
+ return;
- scm_remember_upto_here_1 (old_stream);
+ count = stream->len - stream->pos;
+ if (count > dst->size - dst->end)
+ count = dst->size - dst->end;
- /* reset buffer. */
- {
- pt->stream = SCM_UNPACK (new_stream);
- pt->read_buf = pt->write_buf = (unsigned char *)dst;
- pt->read_pos = pt->write_pos = pt->write_buf + offset;
- pt->write_end = pt->write_buf + pt->write_buf_size;
- pt->read_end = pt->read_buf + pt->read_buf_size;
- }
+ memcpy (dst->buf + dst->end,
+ SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
+ count);
+ dst->end += count;
+ stream->pos += count;
}
static void
-st_write (SCM port, const void *data, size_t size)
+string_port_write (SCM port, scm_t_port_buffer *src)
{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ struct string_port *stream = (void *) SCM_STREAM (port);
+ size_t count = src->end - src->cur;
- if (size > pt->write_end - pt->write_pos)
- st_resize_port (pt, max (pt->write_buf_size * 2,
- pt->write_end - pt->write_pos + size));
-
- memcpy ((char *) pt->write_pos, data, size);
- pt->read_pos = (pt->write_pos += size);
-
- if (pt->read_pos > pt->read_end)
+ if (SCM_BYTEVECTOR_LENGTH (stream->bytevector) < stream->pos + count)
{
- pt->read_end = (unsigned char *) pt->read_pos;
- pt->read_buf_size = pt->read_end - pt->read_buf;
+ SCM new_bv;
+ size_t new_size;
+
+ new_size = max (SCM_BYTEVECTOR_LENGTH (stream->bytevector) * 2,
+ stream->pos + count);
+ new_bv = scm_c_make_bytevector (new_size);
+ memcpy (SCM_BYTEVECTOR_CONTENTS (new_bv),
+ SCM_BYTEVECTOR_CONTENTS (stream->bytevector),
+ stream->len);
+ stream->bytevector = new_bv;
}
-}
-static void
-st_end_input (SCM port, int offset)
-{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (pt->read_pos - pt->read_buf < offset)
- scm_misc_error ("st_end_input", "negative position", SCM_EOL);
-
- pt->write_pos = (unsigned char *) (pt->read_pos = pt->read_pos - offset);
+ memcpy (SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
+ src->buf + src->cur,
+ count);
+ src->cur += count;
+ stream->pos += count;
+ if (stream->pos > stream->len)
+ stream->len = stream->pos;
}
static scm_t_off
-st_seek (SCM port, scm_t_off offset, int whence)
+string_port_seek (SCM port, scm_t_off offset, int whence)
+#define FUNC_NAME "string_port_seek"
{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ struct string_port *stream = (void *) SCM_STREAM (port);
scm_t_off target;
- switch (whence)
- {
- case SEEK_CUR:
- target = pt->read_pos - pt->read_buf + offset;
- break;
- case SEEK_END:
- target = pt->read_end - pt->read_buf + offset;
- break;
- default: /* SEEK_SET */
- target = offset;
- break;
- }
-
- if (target < 0)
- scm_misc_error ("st_seek", "negative offset", SCM_EOL);
-
- if (target >= pt->write_buf_size)
- {
- if (!(SCM_CELL_WORD_0 (port) & SCM_WRTNG))
- {
- if (target > pt->write_buf_size)
- {
- scm_misc_error ("st_seek",
- "seek past end of read-only strport",
- SCM_EOL);
- }
- }
- else if (target == pt->write_buf_size)
- st_resize_port (pt, target * 2);
- }
+ if (whence == SEEK_CUR)
+ target = offset + stream->pos;
+ else if (whence == SEEK_SET)
+ target = offset;
+ else if (whence == SEEK_END)
+ target = offset + stream->len;
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
- pt->read_pos = pt->write_pos = pt->read_buf + target;
- if (pt->read_pos > pt->read_end)
- {
- pt->read_end = (unsigned char *) pt->read_pos;
- pt->read_buf_size = pt->read_end - pt->read_buf;
- }
+ if (target >= 0 && target <= stream->len)
+ stream->pos = target;
+ else
+ scm_out_of_range (FUNC_NAME, scm_from_long (offset));
return target;
}
+#undef FUNC_NAME
-static void
-st_truncate (SCM port, scm_t_off length)
-{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- if (length > pt->write_buf_size)
- st_resize_port (pt, length);
-
- pt->read_buf_size = length;
- pt->read_end = pt->read_buf + length;
- if (pt->read_pos > pt->read_end)
- pt->read_pos = pt->write_pos = pt->read_end;
-}
+
/* The initial size in bytes of a string port's buffer. */
#define INITIAL_BUFFER_SIZE 128
@@ -226,10 +145,9 @@ st_truncate (SCM port, scm_t_off length)
SCM
scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
{
- SCM z, buf;
- scm_t_port *pt;
- size_t read_buf_size, num_bytes, c_byte_pos;
- char *c_buf;
+ SCM buf;
+ size_t len, byte_pos;
+ struct string_port *stream;
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
@@ -237,54 +155,34 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char
*caller)
if (scm_is_false (str))
{
/* Allocate a new buffer to write to. */
- num_bytes = INITIAL_BUFFER_SIZE;
- buf = scm_c_make_bytevector (num_bytes);
- c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
-
- /* Reset `read_buf_size'. It will contain the actual number of
- bytes written to the port. */
- read_buf_size = 0;
- c_byte_pos = 0;
+ buf = scm_c_make_bytevector (INITIAL_BUFFER_SIZE);
+ len = byte_pos = 0;
}
else
{
- char *copy;
-
SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
- /* STR is a string. */
- /* Create a copy of STR in UTF-8. */
- copy = scm_to_utf8_stringn (str, &num_bytes);
- buf = scm_c_make_bytevector (num_bytes);
- c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
- memcpy (c_buf, copy, num_bytes);
- free (copy);
-
- read_buf_size = num_bytes;
+ buf = scm_string_to_utf8 (str);
+ len = scm_c_bytevector_length (buf);
if (scm_is_eq (pos, SCM_INUM0))
- c_byte_pos = 0;
+ byte_pos = 0;
else
/* Inefficient but simple way to convert the character position
- POS into a byte position C_BYTE_POS. */
+ POS into a byte position BYTE_POS. */
free (scm_to_utf8_stringn (scm_substring (str, SCM_INUM0, pos),
- &c_byte_pos));
+ &byte_pos));
}
- z = scm_c_make_port_with_encoding (scm_tc16_strport, modes,
- "UTF-8",
- scm_i_default_port_conversion_handler (),
- SCM_UNPACK (buf));
-
- pt = SCM_PTAB_ENTRY (z);
-
- pt->write_buf = pt->read_buf = (unsigned char *) c_buf;
- pt->read_pos = pt->write_pos = pt->read_buf + c_byte_pos;
- pt->read_buf_size = read_buf_size;
- pt->write_buf_size = num_bytes;
- pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
+ stream = scm_gc_typed_calloc (struct string_port);
+ stream->bytevector = buf;
+ stream->pos = byte_pos;
+ stream->len = len;
- return z;
+ return scm_c_make_port_with_encoding (scm_tc16_strport, modes,
+ "UTF-8",
+ scm_i_default_port_conversion_handler
(),
+ (scm_t_bits) stream);
}
/* Create a new string from the buffer of PORT, a string port, converting from
@@ -292,12 +190,16 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char
*caller)
SCM
scm_strport_to_string (SCM port)
{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ signed char *ptr;
+ struct string_port *stream = (void *) SCM_STREAM (port);
- if (pt->read_buf_size == 0)
+ scm_flush (port);
+
+ if (stream->len == 0)
return scm_nullstr;
- return scm_from_port_stringn ((char *)pt->read_buf, pt->read_buf_size, port);
+ ptr = SCM_BYTEVECTOR_CONTENTS (stream->bytevector);
+ return scm_from_port_stringn ((char *) ptr, stream->len, port);
}
SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
@@ -364,7 +266,7 @@ SCM_DEFINE (scm_open_input_string, "open-input-string", 1,
0, 0,
"by the garbage collector if it becomes inaccessible.")
#define FUNC_NAME s_scm_open_input_string
{
- SCM p = scm_mkstrport(SCM_INUM0, str, SCM_OPN | SCM_RDNG, FUNC_NAME);
+ SCM p = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_RDNG, FUNC_NAME);
return p;
}
#undef FUNC_NAME
@@ -473,13 +375,12 @@ scm_eval_string (SCM string)
}
static scm_t_bits
-scm_make_stptob ()
+scm_make_string_port_type ()
{
- scm_t_bits tc = scm_make_port_type ("string", st_fill_input, st_write);
-
- scm_set_port_end_input (tc, st_end_input);
- scm_set_port_seek (tc, st_seek);
- scm_set_port_truncate (tc, st_truncate);
+ scm_t_bits tc = scm_make_port_type ("string",
+ string_port_read,
+ string_port_write);
+ scm_set_port_seek (tc, string_port_seek);
return tc;
}
@@ -487,7 +388,7 @@ scm_make_stptob ()
void
scm_init_strports ()
{
- scm_tc16_strport = scm_make_stptob ();
+ scm_tc16_strport = scm_make_string_port_type ();
#include "libguile/strports.x"
}
diff --git a/libguile/vports.c b/libguile/vports.c
index 6504128..82fef1e 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -22,6 +22,7 @@
# include <config.h>
#endif
+#include <assert.h>
#include <stdio.h>
#include <errno.h>
@@ -58,73 +59,68 @@ struct soft_port {
SCM read_char;
SCM close;
SCM input_waiting;
+ scm_t_port_buffer *encode_buf;
};
+/* Sadly it seems that most code expects there to be no write buffering
+ at all. */
static void
-soft_port_flush (SCM port)
+soft_port_get_natural_buffer_sizes (SCM port, size_t *read_size,
+ size_t *write_size)
{
- struct soft_port *stream = (void *) SCM_STREAM (port);
-
- if (scm_is_true (stream->flush))
- scm_call_0 (stream->flush);
+ *write_size = 1;
}
static void
-soft_port_write (SCM port, const void *data, size_t size)
+soft_port_write (SCM port, scm_t_port_buffer *buf)
{
struct soft_port *stream = (void *) SCM_STREAM (port);
+ scm_t_uint8 * ptr = buf->buf + buf->cur;
+ SCM str = scm_from_port_stringn ((char *) ptr, buf->end - buf->cur, port);
+ buf->end = buf->cur = 0;
- /* DATA is assumed to be a locale-encoded C string, which makes it
- hard to reliably pass binary data to a soft port. It can be
- achieved by choosing a Latin-1 locale, though, but the recommended
- approach is to use an R6RS "custom binary output port" instead. */
- scm_call_1 (stream->write_string,
- scm_from_locale_stringn ((char *) data, size));
-}
+ scm_call_1 (stream->write_string, str);
-/* calling the flush proc (element 2) is in case old code needs it,
- but perhaps softports could the use port buffer in the same way as
- fports. */
+ /* Backwards compatibility. */
+ if (scm_is_true (stream->flush))
+ scm_call_0 (stream->flush);
+}
/* places a single char in the input buffer. */
-static int
-soft_port_fill_input (SCM port)
+static void
+soft_port_read (SCM port, scm_t_port_buffer *dst)
{
struct soft_port *stream = (void *) SCM_STREAM (port);
- SCM ans;
- scm_t_wchar c;
- scm_t_port_internal *pti;
-
- ans = scm_call_0 (stream->read_char);
- if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans))
- return EOF;
- SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "soft_port_fill_input");
- pti = SCM_PORT_GET_INTERNAL (port);
-
- c = SCM_CHAR (ans);
+ scm_t_port_buffer *encode_buf = stream->encode_buf;
- if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1
- || (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8 && c < 0xff))
+ /* A character can be more than one byte, but we don't have a
+ guarantee that there is more than one byte in the read buffer. So,
+ use an intermediate buffer. Terrible. This whole facility should
+ be (re)designed. */
+ if (encode_buf->cur == encode_buf->end)
{
- scm_t_port *pt = SCM_PTAB_ENTRY (port);
-
- *pt->read_buf = c;
- pt->read_pos = pt->read_buf;
- pt->read_end = pt->read_buf + 1;
- }
- else
- {
- long line = SCM_LINUM (port);
- int column = SCM_COL (port);
-
- scm_ungetc_unlocked (c, port);
-
- SCM_LINUM (port) = line;
- SCM_COL (port) = column;
+ SCM ans;
+ char *str;
+ size_t len;
+
+ ans = scm_call_0 (stream->read_char);
+ if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans))
+ return;
+ SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "soft_port_read");
+
+ /* It's possible to make a fast path here, but it would be fastest
+ if the read procedure could fill its buffer directly. */
+ str = scm_to_port_stringn (scm_string (scm_list_1 (ans)), &len, port);
+ assert (len > 0 && len <= encode_buf->size);
+ encode_buf->cur = 0;
+ encode_buf->end = len;
+ memcpy (encode_buf->buf, str, len);
+ free (str);
}
- return c;
+ while (dst->end < dst->size && encode_buf->cur < encode_buf->end)
+ dst->buf[dst->end++] = encode_buf->buf[encode_buf->cur++];
}
@@ -199,7 +195,6 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
#define FUNC_NAME s_scm_make_soft_port
{
int vlen;
- SCM z;
struct soft_port *stream;
SCM_VALIDATE_VECTOR (1, pv);
@@ -216,11 +211,10 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
stream->input_waiting =
vlen == 6 ? SCM_SIMPLE_VECTOR_REF (pv, 5) : SCM_BOOL_F;
- z = scm_c_make_port (scm_tc16_soft_port, scm_i_mode_bits (modes),
- (scm_t_bits) stream);
- scm_port_non_buffer (SCM_PTAB_ENTRY (z));
+ stream->encode_buf = scm_c_make_port_buffer (10);
- return z;
+ return scm_c_make_port (scm_tc16_soft_port, scm_i_mode_bits (modes),
+ (scm_t_bits) stream);
}
#undef FUNC_NAME
@@ -228,12 +222,13 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
static scm_t_bits
scm_make_sfptob ()
{
- scm_t_bits tc = scm_make_port_type ("soft", soft_port_fill_input,
+ scm_t_bits tc = scm_make_port_type ("soft", soft_port_read,
soft_port_write);
- scm_set_port_flush (tc, soft_port_flush);
scm_set_port_close (tc, soft_port_close);
scm_set_port_needs_close_on_gc (tc, 1);
+ scm_set_port_get_natural_buffer_sizes (tc,
+ soft_port_get_natural_buffer_sizes);
scm_set_port_input_waiting (tc, soft_port_input_waiting);
return tc;
diff --git a/test-suite/standalone/test-scm-c-read.c
b/test-suite/standalone/test-scm-c-read.c
index 5f11e75..86bca48 100644
--- a/test-suite/standalone/test-scm-c-read.c
+++ b/test-suite/standalone/test-scm-c-read.c
@@ -33,52 +33,39 @@
/* Size of our port's internal buffer. */
#define PORT_BUFFER_SIZE 1024
+struct custom_port
+{
+ size_t pos;
+ size_t len;
+ char *buf;
+};
+
+
/* Return a new port of type PORT_TYPE. */
static inline SCM
make_port (scm_t_bits port_type)
{
- SCM port;
- char *c_buffer;
- scm_t_port *c_port;
-
- c_buffer = scm_gc_calloc (PORT_BUFFER_SIZE, "custom-port-buffer");
+ struct custom_port *stream = scm_gc_typed_calloc (struct custom_port);
- port = scm_new_port_table_entry (port_type);
+ stream->pos = 0;
+ stream->len = PORT_BUFFER_SIZE;
+ stream->buf = scm_gc_calloc (stream->len, "custom-port-buffer");
- /* Associate C_BUFFER with PORT, for test purposes. */
- SCM_SETSTREAM (port, (scm_t_bits) c_buffer);
-
- /* Use C_BUFFER as PORT's internal buffer. */
- c_port = SCM_PTAB_ENTRY (port);
- c_port->read_pos = c_port->read_buf = (unsigned char *) c_buffer;
- c_port->read_end = (unsigned char *) c_buffer + PORT_BUFFER_SIZE;
- c_port->read_buf_size = PORT_BUFFER_SIZE;
-
- /* Mark PORT as open and readable. */
- SCM_SET_CELL_TYPE (port, port_type | SCM_OPN | SCM_RDNG);
-
- return port;
+ return scm_c_make_port (port_type, SCM_RDNG, (scm_t_bits) stream);
}
-/* Read one byte from PORT. */
-static int
-fill_input (SCM port)
+static void
+custom_port_read (SCM port, scm_t_port_buffer *dst)
{
- int result;
- scm_t_port *c_port = SCM_PTAB_ENTRY (port);
-
- /* Make sure that C_PORT's internal buffer wasn't changed behind our back.
- See http://lists.gnu.org/archive/html/guile-devel/2008-11/msg00042.html
- for an example where this assumption matters. */
- assert (c_port->read_buf == (unsigned char *) SCM_STREAM (port));
- assert (c_port->read_buf_size == PORT_BUFFER_SIZE);
+ size_t to_copy = dst->size - dst->end;
+ struct custom_port *stream = (void *) SCM_STREAM (port);
- if (c_port->read_pos >= c_port->read_end)
- result = EOF;
- else
- result = (int) *c_port->read_pos++;
+ if (stream->pos + to_copy > stream->len)
+ to_copy = stream->len - stream->pos;
- return result;
+ memcpy (dst->buf + dst->end, stream->buf + stream->pos, to_copy);
+ stream->pos += to_copy;
+ dst->end += to_copy;
}
/* Return true (non-zero) if BUF contains only zeros. */
@@ -103,7 +90,7 @@ do_start (void *arg)
char buffer[PORT_BUFFER_SIZE + (PORT_BUFFER_SIZE / 2)];
size_t read, last_read;
- port_type = scm_make_port_type ("custom-input-port", fill_input, NULL);
+ port_type = scm_make_port_type ("custom-input-port", custom_port_read, NULL);
port = make_port (port_type);
read = 0;
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 674768e..1441daf 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -789,6 +789,7 @@ not `set-port-position!'"
(port (make-custom-binary-output-port "cbop" write!
#f #f #f)))
(put-bytevector port source)
+ (force-output port)
(and (= sink-pos (bytevector-length source))
(not eof?)
(bytevector=? sink source))))
@@ -813,6 +814,7 @@ not `set-port-position!'"
(port (make-custom-binary-output-port "cbop" write!
#f #f #f)))
(put-bytevector port source)
+ (force-output port)
(and (= sink-pos (bytevector-length source))
(not eof?)
(bytevector=? sink source))))
@@ -873,6 +875,7 @@ not `set-port-position!'"
(let* ((t (make-transcoder (latin-1-codec) (native-eol-style)
(error-handling-mode raise)))
(tp (transcoded-port p t)))
+ (setvbuf tp 'none)
(guard (c ((i/o-encoding-error? c)
(and (eq? (i/o-error-port c) tp)
(char=? (i/o-encoding-error-char c) #\λ)
diff --git a/test-suite/tests/web-client.test b/test-suite/tests/web-client.test
index 3133b73..805baa9 100644
--- a/test-suite/tests/web-client.test
+++ b/test-suite/tests/web-client.test
@@ -471,8 +471,7 @@ Connection: close\r
(error "Port closed for writing"))
(put-u8 request-port (char->integer c)))
(define (put-string s)
- (string-for-each put-char s))
- (define (flush)
+ (string-for-each put-char s)
(set! writing? #f)
(set! reading? #t)
(let* ((p (open-bytevector-input-port (get-bytevector)))
@@ -500,8 +499,13 @@ Connection: close\r
(when writing?
(unless (eof-object? (get-u8 response-body-port))
(error "Failed to consume all of body"))))
- (proc (make-soft-port (vector put-char put-string flush get-char close)
- "rw"))))))
+ (let ((soft-port (make-soft-port
+ (vector put-char put-string #f get-char close)
+ "rw")))
+ ;; Arrange it so that the only time our put-char/put-string
+ ;; functions are called is during force-output.
+ (setvbuf soft-port 'block 10000)
+ (proc soft-port))))))
(define* (check-transaction method uri
request-headers request-body request-body-encoding
- [Guile-commits] 07/18: Remove port free functions; just close instead, (continued)
- [Guile-commits] 07/18: Remove port free functions; just close instead, Andy Wingo, 2016/04/06
- [Guile-commits] 16/18: When making soft port, parse handlers into struct, Andy Wingo, 2016/04/06
- [Guile-commits] 12/18: Whitespace fixes, Andy Wingo, 2016/04/06
- [Guile-commits] 05/18: Move line-buffing machinery to ports.c, Andy Wingo, 2016/04/06
- [Guile-commits] 10/18: Custom binary port internals refactor, Andy Wingo, 2016/04/06
- [Guile-commits] 04/18: Use symbols instead of _IONBF values as args to setvbuf, Andy Wingo, 2016/04/06
- [Guile-commits] 03/18: Move setvbuf impl to ports.[ch], Andy Wingo, 2016/04/06
- [Guile-commits] 09/18: Cosmetic changes to r6rs-ports.c, Andy Wingo, 2016/04/06
- [Guile-commits] 17/18: Port close functions return void, Andy Wingo, 2016/04/06
- [Guile-commits] 11/18: Refactor to rw_random / rw_active port flags, Andy Wingo, 2016/04/06
- [Guile-commits] 18/18: Generic port facility provides buffering uniformly,
Andy Wingo <=