mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Generic port facility provides buffering uniformly

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2016-04-06 09:21:44 +02:00
parent e8eeeeb1d4
commit 8399e7af51
17 changed files with 1033 additions and 1629 deletions
Download patch file Download diff file Expand all files Collapse all files

420
doc/ref/api-io.texi
View file

@ -12,13 +12,14 @@
* Reading:: Procedures for reading from a port. * Reading:: Procedures for reading from a port.
* Writing:: Procedures for writing to a port. * Writing:: Procedures for writing to a port.
* Closing:: Procedures to close a port. * Closing:: Procedures to close a port.
* Buffering:: Controlling when data is written to ports.
* Random Access:: Moving around a random access port. * Random Access:: Moving around a random access port.
* Line/Delimited:: Read and write lines or delimited text. * Line/Delimited:: Read and write lines or delimited text.
* Block Reading and Writing:: Reading and writing blocks of text. * Block Reading and Writing:: Reading and writing blocks of text.
* Default Ports:: Defaults for input, output and errors. * Default Ports:: Defaults for input, output and errors.
* Port Types:: Types of port and how to make them. * Port Types:: Types of port and how to make them.
* R6RS I/O Ports:: The R6RS port API. * 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. * BOM Handling:: Handling of Unicode byte order marks.
@end menu @end menu
@ -32,26 +33,21 @@ Sequential input/output in Scheme is represented by operations on a
for working with ports. for working with ports.
Ports are created by opening, for instance @code{open-file} for a file 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 (@pxref{File Ports}). Other kinds of ports include @dfn{soft ports} and
written to an output port, or both on an input/output port. A port @dfn{string ports} (@pxref{Soft Ports}, and @ref{String Ports}).
can be closed (@pxref{Closing}) when no longer required, after which Characters or bytes can be read from an input port and written to an
any attempt to read or write is an error. 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
The formal definition of a port is very generic: an input port is read or write is an error.
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}.)
Ports are garbage collected in the usual way (@pxref{Memory Ports are garbage collected in the usual way (@pxref{Memory
Management}), and will be closed at that time if not already closed. Management}), and will be closed at that time if not already closed. In
In this case any errors occurring in the close will not be reported. 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 Usually a program will want to explicitly close so as to be sure all its
its operations have been successful. Of course if a program has operations have been successful, including any buffered writes
abandoned something due to an error or other condition then closing (@pxref{Buffering}). Of course if a program has abandoned something due
problems are probably not of interest. 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 It is strongly recommended that file ports be closed explicitly when
no longer required. Most systems have limits on how many files can be 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. read and written on a 32-bit system.
Each port has an associated character encoding that controls how bytes Each port has an associated character encoding that controls how bytes
read from the port are converted to characters and string and controls read from the port are converted to characters and controls how
how characters and strings written to the port are converted to bytes. characters written to the port are converted to bytes. When ports are
When ports are created, they inherit their character encoding from the created, they inherit their character encoding from the current locale,
current locale, but, that can be modified after the port is created. but, that can be modified after the port is created.
Currently, the ports only work with @emph{non-modal} encodings. Most Currently, the ports only work with @emph{non-modal} encodings. Most
encodings are non-modal, meaning that the conversion of bytes to a 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 raise an error, to replace the character with a hex escape, or to
replace the character with a substitute character. 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? @rnindex input-port?
@deffn {Scheme Procedure} input-port? x @deffn {Scheme Procedure} input-port? x
@deffnx {C Function} scm_input_port_p (x) @deffnx {C Function} scm_input_port_p (x)
@ -188,8 +193,6 @@ equivalent to @code{(fluid-set! %default-port-conversion-strategy
@subsection Reading @subsection Reading
@cindex Reading @cindex Reading
[Generic procedures for reading from ports.]
These procedures pertain to reading characters and strings from These procedures pertain to reading characters and strings from
ports. To read general S-expressions from ports, @xref{Scheme Read}. 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 @subsection Writing
@cindex Writing @cindex Writing
[Generic procedures for writing to ports.]
These procedures are for writing characters and strings to These procedures are for writing characters and strings to
ports. For more information on writing arbitrary Scheme objects to ports. For more information on writing arbitrary Scheme objects to
ports, @xref{Scheme Write}. ports, @xref{Scheme Write}.
@ -380,6 +381,14 @@ Note that this function does not update @code{port-line} and
@code{port-column} (@pxref{Reading}). @code{port-column} (@pxref{Reading}).
@end deftypefn @end deftypefn
@deftypefn {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.
@end deftypefn
@findex fflush @findex fflush
@deffn {Scheme Procedure} force-output [port] @deffn {Scheme Procedure} force-output [port]
@deffnx {C Function} scm_force_output (port) @deffnx {C Function} scm_force_output (port)
@ -435,6 +444,96 @@ open.
@end deffn @end deffn
@node Buffering
@subsection Buffering
@cindex 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
@code{write-char} 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}.
@deffn {Scheme Procedure} setvbuf port mode [size]
@deffnx {C Function} scm_setvbuf (port, mode, size)
@cindex port buffering
Set the buffering mode for @var{port}. @var{mode} can be one of the
following symbols:
@table @code
@item none
non-buffered
@item line
line buffered
@item block
block buffered, using a newly allocated buffer of @var{size} bytes.
If @var{size} is omitted, a default size will be used.
@end table
@end 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.
@xref{Streams,,,libc,The GNU C Library Reference Manual}, for more
discussion on C streams.
@node Random Access @node Random Access
@subsection Random Access @subsection Random Access
@cindex Random access, ports @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 operations are passed directly to the underlying port
implementation without additional buffering. This is likely to implementation without additional buffering. This is likely to
slow down I/O operations. The buffering mode can be changed slow down I/O operations. The buffering mode can be changed
while a port is in use @pxref{Ports and File Descriptors, while a port is in use (@pxref{Buffering}).
setvbuf}
@item l @item l
Add line-buffering to the port. The port output buffer will be Add line-buffering to the port. The port output buffer will be
automatically flushed whenever a newline character is written. 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. invoked when the custom binary input port is closed.
The returned port is fully buffered by default, but its buffering mode The returned port is fully buffered by default, but its buffering mode
can be changed using @code{setvbuf} (@pxref{Ports and File Descriptors, can be changed using @code{setvbuf} (@pxref{Buffering}).
@code{setvbuf}}).
Using a custom binary input port, the @code{open-bytevector-input-port} Using a custom binary input port, the @code{open-bytevector-input-port}
procedure could be implemented as follows: procedure could be implemented as follows:
@ -2157,152 +2254,111 @@ the representation, will return an object equal (in the sense of
@end deffn @end deffn
@node I/O Extensions @node I/O Extensions
@subsection Using and Extending Ports in C @subsection Implementing New Port Types in C
@menu This section describes how to implement a new port type in C. Before
* C Port Interface:: Using ports from C. getting to the details, here is a summary of how the generic port
* Port Implementation:: How to implement a new port type in C. interface works internally.
@end menu
@node C Port Interface
@subsubsection C Port Interface
@cindex C port interface
@cindex Port, C interface
This section describes how to use Scheme ports from C.
@subsubheading Port basics
@cindex ptob @cindex ptob
@tindex scm_ptob_descriptor @tindex scm_t_ptob_descriptor
@tindex scm_port @tindex scm_t_port
@tindex scm_t_port_buffer
@findex SCM_PTAB_ENTRY @findex SCM_PTAB_ENTRY
@findex SCM_PTOBNUM @findex SCM_PTOBNUM
@vindex scm_ptobs @vindex scm_ptobs
There are two main data structures. A port type object (ptob) is of Guile's port facility consists of three main data structures. A port
type @code{scm_ptob_descriptor}. A port instance is of type type object (ptob) is of type @code{scm_t_ptob_descriptor}, and holds
@code{scm_port}. Given an @code{SCM} variable which points to a port, pointers to the methods that implement the port type. A port instance
the corresponding C port object can be obtained using the is of type @code{scm_t_port}, and holds all state for the port. Finally
@code{SCM_PTAB_ENTRY} macro. The ptob can be obtained by using the read and write buffers are the @code{read_buf} and @code{write_buf}
@code{SCM_PTOBNUM} to give an index into the @code{scm_ptobs} members of the port instance, and are of type @code{scm_t_port_buffer}.
global array.
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 @subsubheading Port buffers
An input port always has a read buffer and an output port always has a 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 write buffer. @xref{Buffering}. These buffers are represented in C by
more than one byte (e.g., the @code{shortbuf} field in @code{scm_port} @code{scm_t_port_buffer} objects.
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 The port buffer consists of data as a byte array, pointed to by its
example in the case of an fport, buffers may be allocated with malloc @code{buf} field. The valid data in the buffer is between the
when the port is created, but in the case of an strport the underlying @code{cur} and @code{end} indices into @code{buf}; @code{cur} must
string is used as the buffer. 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 @subsubheading The @code{rw_random} flag
Special treatment is required for ports which can be seeked at random. Special treatment is required for ports which can be seeked at random.
Before various operations, such as seeking the port or changing from Before various operations, such as seeking the port or changing from
input to output on a bidirectional port or vice versa, the port input to output on a bidirectional port or vice versa. Seeking on a
implementation must be given a chance to update its state. The write port with buffered input, or switching to writing after reading, will
buffer is updated by calling the @code{flush} ptob procedure and the cause the buffered input to be discarded and Guile will seek the port
input buffer is updated by calling the @code{end_input} ptob procedure. back the buffered number of bytes. Likewise seeking on a port with
In the case of an fport, @code{flush} causes buffered output to be buffered output, or switching to reading after writing, will flush
written to the file descriptor, while @code{end_input} causes the pending bytes with a call to the @code{write} procedure. Indicate to
descriptor position to be adjusted to account for buffered input which Guile that your port needs this behavior by setting the @code{rw_random}
was never read. flag. This flag is set by default if the port type supplies a seek
implementation.
The special treatment must be performed if the @code{rw_random} flag in @subsubheading C interface
the port is non-zero.
@subsubheading The @code{rw_active} variable A port type object is created by calling @code{scm_make_port_type}.
The @code{rw_active} variable in the port is only used if @deftypefun 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))
@code{rw_random} is set. It's defined as an enum with the following Return a new port type object. The @var{name}, @var{read} and
values: @var{write} parameters are initial values for those port type fields, as
described below. The other fields are initialized with default values
@table @code and can be changed later.
@item SCM_PORT_READ
the read buffer may have unread data.
@item SCM_PORT_WRITE
the write buffer may have unwritten data.
@item SCM_PORT_NEITHER
neither the write nor the read buffer has data.
@end table
@subsubheading 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:
@enumerate
@item
Flush output on the port, if @code{rw_active} is @code{SCM_PORT_WRITE}.
@item
Fill the read buffer, if it's empty, using @code{scm_fill_input}.
@item 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.
@item Set rw_active to @code{SCM_PORT_READ} if @code{rw_random} is set.
@item update the port's line and column counts.
@end enumerate
@subsubheading 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:
@enumerate
@item
End input on the port, if @code{rw_active} is @code{SCM_PORT_READ}.
@item
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
@code{shortbuf}.
@item
Set @code{rw_active} to @code{SCM_PORT_WRITE} if @code{rw_random}
is set.
@end enumerate
@node Port Implementation
@subsubsection Port Implementation
@cindex 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}.
@deftypefun 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
@var{write} 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 @end deftypefun
All of the elements of the ptob, apart from @code{name}, are procedures All of the elements of the port type object, apart from @code{name}, are
which collectively implement the port behaviour. Creating a new port procedures which collectively implement the port behaviour. Creating a
type mostly involves writing these procedures. new port type mostly involves writing these procedures.
@table @code @table @code
@item name @item name
A pointer to a NUL terminated string: the name of the port type. This 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}. a procedure. Set via the first argument to @code{scm_make_port_type}.
@item read
A port's @code{read} implementation fills read buffers. It should copy
bytes to the supplied port buffer object, advancing the buffer's
@code{end} field as appropriate, but not past the buffer's @code{size}
field.
@item 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 @item print
Called when @code{write} is called on the port object, to print a 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: 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) @deftypefun void scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p)
@end deftypefun @end deftypefun
@item 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}.
@item flush
Complete the processing of buffered output data. Reset the value of
@code{rw_active} to @code{SCM_PORT_NEITHER}.
Set using
@deftypefun void scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port))
@end deftypefun
@item 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
@deftypefun void scm_set_port_end_input (scm_t_bits tc, void (*end_input) (SCM port, int offset))
@end deftypefun
@item 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}.
@item 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
@code{rw_active} is @code{SCM_PORT_NEITHER}.
Set using
@deftypefun void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM port))
@end deftypefun
@item seek @item seek
Set the current position of the port. The procedure can not make Set the current position of the port. Guile will flush read and/or
any assumptions about the value of @code{rw_active} when it's write buffers before seeking, as appropriate.
called. It can reset the buffers first if desired by using something
like:
@example
if (pt->rw_active == SCM_PORT_READ)
scm_end_input (port);
else if (pt->rw_active == SCM_PORT_WRITE)
ptob->flush (port);
@end 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
@code{end_input} and @code{flush} ptob procedures. This is undesirable
when seek is called to measure the current position of the port, i.e.,
@code{(seek p 0 SEEK_CUR)}. The libguile fport and string port
implementations take care to avoid this problem.
The procedure is set using
@deftypefun void scm_set_port_seek (scm_t_bits tc, scm_t_off (*seek) (SCM port, scm_t_off offset, int whence)) @deftypefun void scm_set_port_seek (scm_t_bits tc, scm_t_off (*seek) (SCM port, scm_t_off offset, int whence))
@end deftypefun @end deftypefun
@item truncate @item truncate
Truncate the port data to be specified length. It can be assumed that the Truncate the port data to be specified length. Guile will flush buffers
current state of @code{rw_active} is @code{SCM_PORT_NEITHER}. before hand, as appropriate. Set using
Set using
@deftypefun void scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, scm_t_off length)) @deftypefun void scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, scm_t_off length))
@end deftypefun @end deftypefun

69
doc/ref/posix.texi
View file

@ -133,18 +133,6 @@ then the return is @code{#f}. For example,
Conventions generally follow those of scsh, @ref{The Scheme shell (scsh)}. 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
@ref{File 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. Each open file port has an associated operating system file descriptor.
File descriptors are generally not useful in Scheme programs; however File descriptors are generally not useful in Scheme programs; however
they may be needed when interfacing with foreign code and the Unix 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 ports will not result in its garbage collection: it could be retrieved
with @code{fdopen} or @code{fdes->ports}. 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}.
@xref{Buffering}, 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 @deffn {Scheme Procedure} port-revealed port
@deffnx {C Function} scm_port_revealed (port) @deffnx {C Function} scm_port_revealed (port)
Return the revealed count for @var{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. return value is unspecified.
@end deffn @end deffn
@deffn {Scheme Procedure} unread-char char [port]
@deffnx {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.
@end deffn
@deffn {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
@var{port} is not supplied, the current-input-port is used.
@end deffn
@deffn {Scheme Procedure} pipe @deffn {Scheme Procedure} pipe
@deffnx {C Function} scm_pipe () @deffnx {C Function} scm_pipe ()
@cindex pipe @cindex pipe
Return a newly created pipe: a pair of ports which are linked Return a newly created pipe: a pair of ports which are linked together
together on the local machine. The @acronym{CAR} is the input on the local machine. The @acronym{CAR} is the input port and the
port and the @acronym{CDR} is the output port. Data written (and @acronym{CDR} is the output port. Data written (and flushed) to the
flushed) to the output port can be read from the input port. output port can be read from the input port. Pipes are commonly used
Pipes are commonly used for communication with a newly forked for communication with a newly forked child process. The need to flush
child process. The need to flush the output port can be the output port can be avoided by making it unbuffered using
avoided by making it unbuffered using @code{setvbuf}. @code{setvbuf} (@pxref{Buffering}).
@defvar PIPE_BUF @defvar PIPE_BUF
A write of up to @code{PIPE_BUF} many bytes to a pipe is atomic, 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. used instead.
Care should be taken with @code{OPEN_BOTH}, a deadlock will occur if Care should be taken with @code{OPEN_BOTH}, a deadlock will occur if
both parent and child are writing, and waiting until the write both parent and child are writing, and waiting until the write completes
completes before doing any reading. Each direction has before doing any reading. Each direction has @code{PIPE_BUF} bytes of
@code{PIPE_BUF} bytes of buffering (@pxref{Ports and File buffering (@pxref{Buffering}), which will be enough for small writes,
Descriptors}), which will be enough for small writes, but not for say but not for say putting a big file through a filter.
putting a big file through a filter.
@end deffn @end deffn
@deffn {Scheme Procedure} open-input-pipe command @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}. Socket ports can be created using @code{socket} and @code{socketpair}.
The ports are initially unbuffered, to make reading and writing to the 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 same port more reliable. A buffer can be added to the port using
@code{setvbuf}; see @ref{Ports and File Descriptors}. @code{setvbuf} (@pxref{Buffering}).
Most systems have limits on how many files and sockets can be open, so 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 it's strongly recommended that socket ports be closed explicitly when

4
libguile/filesys.c
View file

@ -652,7 +652,7 @@ set_element (fd_set *set, SCM *ports_ready, SCM element, int pos)
/* check whether port has buffered input. */ /* check whether port has buffered input. */
scm_t_port *pt = SCM_PTAB_ENTRY (element); 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; use_buf = 1;
} }
else if (pos == SCM_ARG2) 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); scm_t_port *pt = SCM_PTAB_ENTRY (element);
/* > 1 since writing the last byte in the buffer causes flush. */ /* > 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; use_buf = 1;
} }
fd = use_buf ? -1 : SCM_FPORT_FDES (element); fd = use_buf ? -1 : SCM_FPORT_FDES (element);

242
libguile/fports.c
View file

@ -75,67 +75,6 @@
scm_t_bits scm_tc16_fport; 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, /* Move ports with the specified file descriptor to new descriptors,
* resetting the revealed count to 0. * 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); 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); 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); SCM_SET_FILENAME (port, name);
return port; return port;
@ -643,28 +576,31 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
return 1; return 1;
} }
static void fport_flush (SCM port);
/* fill a port's read-buffer with a single read. returns the first /* fill a port's read-buffer with a single read. returns the first
char or EOF if end of file. */ char or EOF if end of file. */
static scm_t_wchar static void
fport_fill_input (SCM port) fport_read (SCM port, scm_t_port_buffer *dst)
{ {
long count; long count;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
scm_t_fport *fp = SCM_FSTREAM (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) if (count == -1)
scm_syserror ("fport_fill_input"); scm_syserror ("fport_read");
if (count == 0) dst->end += count;
return (scm_t_wchar) EOF; }
else
{ static void
pt->read_pos = pt->read_buf; fport_write (SCM port, scm_t_port_buffer *src)
pt->read_end = pt->read_buf + count; {
return *pt->read_buf; 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 static scm_t_off
@ -690,122 +626,11 @@ fport_truncate (SCM port, scm_t_off length)
scm_syserror ("ftruncate"); scm_syserror ("ftruncate");
} }
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 static void
fport_close (SCM port) fport_close (SCM port)
{ {
scm_t_fport *fp = SCM_FSTREAM (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) if (close (fp->fdes) != 0)
/* It's not useful to retry after EINTR, as the file descriptor is /* It's not useful to retry after EINTR, as the file descriptor is
in an undefined state. See http://lwn.net/Articles/365294/. in an undefined state. See http://lwn.net/Articles/365294/.
@ -814,20 +639,31 @@ fport_close (SCM port)
scm_syserror ("fport_close"); 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 static scm_t_bits
scm_make_fptob () scm_make_fptob ()
{ {
scm_t_bits tc = scm_make_port_type ("file", fport_fill_input, fport_write); scm_t_bits tc = scm_make_port_type ("file", fport_read, fport_write);
scm_set_port_needs_close_on_gc (tc, 1); scm_set_port_print (tc, fport_print);
scm_set_port_print (tc, fport_print); scm_set_port_needs_close_on_gc (tc, 1);
scm_set_port_flush (tc, fport_flush); scm_set_port_close (tc, fport_close);
scm_set_port_end_input (tc, fport_end_input); scm_set_port_seek (tc, fport_seek);
scm_set_port_close (tc, fport_close); scm_set_port_truncate (tc, fport_truncate);
scm_set_port_seek (tc, fport_seek); scm_set_port_input_waiting (tc, fport_input_waiting);
scm_set_port_truncate (tc, fport_truncate); scm_set_port_get_natural_buffer_sizes (tc, fport_get_natural_buffer_sizes);
scm_set_port_input_waiting (tc, fport_input_waiting);
scm_set_port_setvbuf (tc, scm_fport_buffer_add);
return tc; return tc;
} }

22
libguile/ioext.c
View file

@ -86,19 +86,23 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
newfd = fp->fdes; newfd = fp->fdes;
if (oldfd != newfd) if (oldfd != newfd)
{ {
scm_t_port *pt = SCM_PTAB_ENTRY (new); /* Ensure there is nothing in either port's input or output
scm_t_port *old_pt = SCM_PTAB_ENTRY (old); 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);
/* 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);
ans = dup2 (oldfd, newfd); ans = dup2 (oldfd, newfd);
if (ans == -1) if (ans == -1)
SCM_SYSERROR; 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; return SCM_UNSPECIFIED;
} }

8
libguile/poll.c
View file

@ -108,11 +108,11 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM timeout)
{ {
scm_t_port *pt = SCM_PTAB_ENTRY (port); 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. */ /* Buffered input waiting to be read. */
revents |= POLLIN; revents |= POLLIN;
if (SCM_OUTPUT_PORT_P (port) 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 /* Buffered output possible. The "> 1" is because
writing the last byte would flush the port. */ writing the last byte would flush the port. */
revents |= POLLOUT; 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); 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. */ /* Buffered input waiting to be read. */
revents |= POLLIN; revents |= POLLIN;
if (SCM_OUTPUT_PORT_P (port) 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 /* Buffered output possible. The "> 1" is because
writing the last byte would flush the port. */ writing the last byte would flush the port. */
revents |= POLLOUT; revents |= POLLOUT;

1
libguile/ports-internal.h
View file

@ -50,7 +50,6 @@ struct scm_port_internal
unsigned at_stream_start_for_bom_write : 1; unsigned at_stream_start_for_bom_write : 1;
scm_t_port_encoding_mode encoding_mode; scm_t_port_encoding_mode encoding_mode;
scm_t_iconv_descriptors *iconv_descriptors; scm_t_iconv_descriptors *iconv_descriptors;
int pending_eof;
SCM alist; SCM alist;
}; };

720
libguile/ports.c
View file

File diff suppressed because it is too large Load diff

208
libguile/ports.h
View file

@ -39,8 +39,6 @@
#define SCM_INITIAL_PUTBACK_BUF_SIZE 4
/* values for the rw_active flag. */ /* values for the rw_active flag. */
typedef enum scm_t_port_rw_active { typedef enum scm_t_port_rw_active {
SCM_PORT_NEITHER = 0, SCM_PORT_NEITHER = 0,
@ -51,74 +49,94 @@ typedef enum scm_t_port_rw_active {
/* An internal-only structure defined in ports-internal.h. */ /* An internal-only structure defined in ports-internal.h. */
struct scm_port_internal; 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. */ /* C representation of a Scheme port. */
typedef struct typedef struct
{ {
SCM port; /* Link back to the port object. */ /* Link back to the port object. */
scm_i_pthread_mutex_t *lock; /* A recursive lock for this port. */ SCM port;
/* pointer to internal-only port structure */ /* A recursive lock for this port. */
scm_i_pthread_mutex_t *lock;
/* Pointer to internal-only port structure. */
struct scm_port_internal *internal; 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_t_bits stream;
SCM file_name; /* debugging support. */ /* Source location information. */
long line_number; /* debugging support. */ SCM file_name;
int column_number; /* debugging support. */ long line_number;
int column_number;
/* port buffers. the buffer(s) are set up for all ports. /* Port buffers. */
in the case of string ports, the buffer is the string itself. scm_t_port_buffer *read_buf;
in the case of unbuffered file ports, the buffer is a scm_t_port_buffer *write_buf;
single char: shortbuf. */
/* this buffer is filled from read_buf to read_end using the ptob /* All ports have read and write buffers; an unbuffered port simply
buffer_fill. then input requests are taken from read_pos until has a one-byte buffer. However unreading bytes can expand the read
it reaches read_end. */ 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;
unsigned char *read_buf; /* buffer start. */ /* True if the port is random access. Implies that the buffers must
const unsigned char *read_pos;/* the next unread char. */ be flushed before switching between reading and writing, seeking,
unsigned char *read_end; /* pointer to last buffered char + 1. */ and so on. */
scm_t_off read_buf_size; /* size of the buffer. */ int rw_random;
/* when chars are put back into the buffer, e.g., using peek-char or /* For random access ports, indicates which of the buffers is
unread-string, the read-buffer pointers are switched to cbuf. currently in use. Can be SCM_PORT_WRITE, SCM_PORT_READ, or
the original pointers are saved here and restored when the put-back SCM_PORT_NEITHER. */
chars have been consumed. */ scm_t_port_rw_active rw_active;
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 /* Character encoding support. */
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 */
char *encoding; char *encoding;
scm_t_string_failed_conversion_handler ilseq_handler; scm_t_string_failed_conversion_handler ilseq_handler;
} scm_t_port; } scm_t_port;
@ -127,8 +145,6 @@ typedef struct
SCM_INTERNAL SCM scm_i_port_weak_set; 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)) #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; char *name;
int (*print) (SCM exp, SCM port, scm_print_state *pstate); 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 (*close) (SCM port);
void (*write) (SCM port, const void *data, size_t size); void (*get_natural_buffer_sizes) (SCM port, size_t *read_size,
void (*flush) (SCM port); size_t *write_size);
void (*end_input) (SCM port, int offset);
int (*fill_input) (SCM port);
int (*input_waiting) (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); 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; unsigned flags;
} scm_t_ptob_descriptor; } scm_t_ptob_descriptor;
@ -218,22 +228,16 @@ typedef struct scm_t_ptob_descriptor
SCM_INTERNAL long scm_c_num_port_types (void); SCM_INTERNAL long scm_c_num_port_types (void);
SCM_API scm_t_ptob_descriptor* scm_c_port_type_ref (long ptobnum); 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 long scm_c_port_type_add_x (scm_t_ptob_descriptor *desc);
SCM_API scm_t_bits scm_make_port_type (char *name, SCM_API scm_t_bits scm_make_port_type
int (*fill_input) (SCM port), (char *name,
void (*write) (SCM port, void (*read) (SCM port, scm_t_port_buffer *dst),
const void *data, void (*write) (SCM port, scm_t_port_buffer *src));
size_t size));
SCM_API void scm_set_port_print (scm_t_bits tc, SCM_API void scm_set_port_print (scm_t_bits tc,
int (*print) (SCM exp, int (*print) (SCM exp,
SCM port, SCM port,
scm_print_state *pstate)); scm_print_state *pstate));
SCM_API void scm_set_port_close (scm_t_bits tc, void (*close) (SCM)); 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_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_API void scm_set_port_seek (scm_t_bits tc,
scm_t_off (*seek) (SCM port, scm_t_off (*seek) (SCM port,
scm_t_off OFFSET, scm_t_off OFFSET,
@ -242,8 +246,8 @@ SCM_API void scm_set_port_truncate (scm_t_bits tc,
void (*truncate) (SCM port, void (*truncate) (SCM port,
scm_t_off length)); 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_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM));
SCM_API void scm_set_port_setvbuf (scm_t_bits tc, SCM_API void scm_set_port_get_natural_buffer_sizes
void (*setvbuf) (SCM, long, long)); (scm_t_bits tc, void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *));
/* The input, output, error, and load ports. */ /* The input, output, error, and load ports. */
SCM_API SCM scm_current_input_port (void); 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_API void scm_dynwind_current_error_port (SCM port);
SCM_INTERNAL void scm_i_dynwind_current_load_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. */ /* Mode bits. */
SCM_INTERNAL long scm_i_mode_bits (SCM modes); SCM_INTERNAL long scm_i_mode_bits (SCM modes);
SCM_API long scm_mode_bits (char *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); SCM_API SCM scm_unread_string (SCM str, SCM port);
/* Manipulating the buffers. */ /* 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 SCM scm_setvbuf (SCM port, SCM mode, SCM size);
SCM_API int scm_fill_input (SCM port); SCM_API scm_t_port_buffer* scm_fill_input (SCM port);
SCM_API int scm_fill_input_unlocked (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_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 SCM scm_drain_input (SCM port);
SCM_API void scm_end_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_INLINE_IMPLEMENTATION int
scm_get_byte_or_eof_unlocked (SCM port) 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) if (SCM_LIKELY (buf->cur < buf->end))
&& pt->read_pos < pt->read_end)) return buf->buf[buf->cur++];
return *pt->read_pos++;
else buf = scm_fill_input_unlocked (port);
return scm_slow_get_byte_or_eof_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'. */ /* 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_peek_byte_or_eof_unlocked (SCM port)
{ {
scm_t_port *pt = SCM_PTAB_ENTRY (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) if (SCM_LIKELY (buf->cur < buf->end))
&& pt->read_pos < pt->read_end)) return buf->buf[buf->cur];
return *pt->read_pos;
else buf = scm_fill_input_unlocked (port);
return scm_slow_peek_byte_or_eof_unlocked (port); if (buf->cur < buf->end)
return buf->buf[buf->cur];
return EOF;
} }
SCM_INLINE_IMPLEMENTATION void SCM_INLINE_IMPLEMENTATION void

485
libguile/r6rs-ports.c
View file

@ -78,87 +78,70 @@ SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
/* Bytevector input ports. */ /* Bytevector input ports. */
static scm_t_bits bytevector_input_port_type = 0; static scm_t_bits bytevector_input_port_type = 0;
struct bytevector_input_port {
SCM bytevector;
size_t pos;
};
static inline SCM static inline SCM
make_bytevector_input_port (SCM bv) 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; 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, mode_bits,
NULL, /* encoding */ NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR, SCM_FAILED_CONVERSION_ERROR,
SCM_UNPACK (bv)); (scm_t_bits) stream);
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;
} }
static int static void
bytevector_input_port_fill_input (SCM port) bytevector_input_port_read (SCM port, scm_t_port_buffer *buf)
{ {
int result; size_t count;
scm_t_port *c_port = SCM_PTAB_ENTRY (port); struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
if (c_port->read_pos >= c_port->read_end) if (stream->pos >= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
result = EOF; return;
else
result = (int) *c_port->read_pos;
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 static scm_t_off
bytevector_input_port_seek (SCM port, scm_t_off offset, int whence) bytevector_input_port_seek (SCM port, scm_t_off offset, int whence)
#define FUNC_NAME "bytevector_input_port_seek" #define FUNC_NAME "bytevector_input_port_seek"
{ {
scm_t_off c_result = 0; struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
scm_t_port *c_port = SCM_PTAB_ENTRY (port); scm_t_off target;
switch (whence) if (whence == SEEK_CUR)
{ target = offset + stream->pos;
case SEEK_CUR: else if (whence == SEEK_SET)
offset += c_port->read_pos - c_port->read_buf; target = offset;
/* Fall through. */ 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");
case SEEK_SET: if (target >= 0 && target <= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
if (c_port->read_buf + offset <= c_port->read_end) stream->pos = target;
{ else
c_port->read_pos = c_port->read_buf + offset; scm_out_of_range (FUNC_NAME, scm_from_long (offset));
c_result = offset;
}
else
scm_out_of_range (FUNC_NAME, scm_from_int (offset));
break;
case SEEK_END: return target;
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;
default:
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
"invalid `seek' parameter");
}
return c_result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -169,7 +152,7 @@ initialize_bytevector_input_ports (void)
{ {
bytevector_input_port_type = bytevector_input_port_type =
scm_make_port_type ("r6rs-bytevector-input-port", scm_make_port_type ("r6rs-bytevector-input-port",
bytevector_input_port_fill_input, bytevector_input_port_read,
NULL); NULL);
scm_set_port_seek (bytevector_input_port_type, bytevector_input_port_seek); 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. */ output custom binary ports. */
struct custom_binary_port { struct custom_binary_port {
SCM read_buffer;
SCM read; SCM read;
SCM write; SCM write;
SCM get_position; SCM get_position;
@ -274,154 +256,53 @@ custom_binary_port_close (SCM port)
static scm_t_bits custom_binary_input_port_type = 0; 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 static inline SCM
make_custom_binary_input_port (SCM read_proc, SCM get_position_proc, make_custom_binary_input_port (SCM read_proc, SCM get_position_proc,
SCM set_position_proc, SCM close_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; struct custom_binary_port *stream;
const unsigned long mode_bits = SCM_OPN | SCM_RDNG; 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 = scm_gc_typed_calloc (struct custom_binary_port);
stream->read_buffer = bv;
stream->read = read_proc; stream->read = read_proc;
stream->write = SCM_BOOL_F; stream->write = SCM_BOOL_F;
stream->get_position = get_position_proc; stream->get_position = get_position_proc;
stream->set_position_x = set_position_proc; stream->set_position_x = set_position_proc;
stream->close = close_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, mode_bits,
NULL, /* encoding */ NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR, SCM_FAILED_CONVERSION_ERROR,
(scm_t_bits) stream); (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 static void
custom_binary_input_port_fill_input (SCM port) custom_binary_input_port_read (SCM port, scm_t_port_buffer *buf)
#define FUNC_NAME "custom_binary_input_port_fill_input" #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); struct custom_binary_port *stream = (void *) SCM_STREAM (port);
SCM bv, octets;
size_t c_octets;
if (c_port->read_pos >= c_port->read_end) /* 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,
/* Invoke the user's `read!' procedure. */ pushback could re-set PORT->read_buf, which would be a fail. But,
int buffered; probably buf->buf is itself GC-allocated, so we can pack it
size_t c_octets, c_requested; directly. But, perhaps it's not, as in scm_c_read(). In that
SCM bv, octets; 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));
c_requested = c_port->read_buf_size; 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);
bv = stream->read_buffer; buf->end += c_octets;
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;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -459,12 +340,10 @@ initialize_custom_binary_input_ports (void)
{ {
custom_binary_input_port_type = custom_binary_input_port_type =
scm_make_port_type ("r6rs-custom-binary-input-port", 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_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_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.") "position to point just past these bytes.")
#define FUNC_NAME s_scm_get_bytevector_some #define FUNC_NAME s_scm_get_bytevector_some
{ {
scm_t_port *pt; scm_t_port_buffer *buf;
size_t size; size_t size;
SCM bv; SCM bv;
SCM_VALIDATE_BINARY_INPUT_PORT (1, port); SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
pt = SCM_PTAB_ENTRY (port);
if (pt->rw_active == SCM_PORT_WRITE) buf = scm_fill_input_unlocked (port);
scm_flush_unlocked (port); if (buf->cur == buf->end)
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
if (pt->read_pos >= pt->read_end)
{ {
if (scm_fill_input_unlocked (port) == EOF) buf->has_eof = 0;
return SCM_EOF_VAL; return SCM_EOF_VAL;
} }
size = pt->read_end - pt->read_pos; size = buf->end - buf->cur;
if (pt->read_buf == pt->putback_buf)
size += pt->saved_read_end - pt->saved_read_pos;
bv = scm_c_make_bytevector (size); bv = scm_c_make_bytevector (size);
scm_take_from_input_buffers scm_take_from_input_buffers
(port, (char *) SCM_BYTEVECTOR_CONTENTS (bv), size); (port, (char *) SCM_BYTEVECTOR_CONTENTS (bv), size);
@ -838,6 +708,10 @@ typedef struct
size_t len; size_t len;
size_t pos; size_t pos;
char *buffer; char *buffer;
/* The get-bytevector procedure will flush this port, if it's
open. */
SCM port;
} scm_t_bytevector_output_port_buffer; } 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->total_len = buf->len = buf->pos = 0;
buf->buffer = NULL; buf->buffer = NULL;
/* Don't clear the port. */
} }
static inline void static inline void
@ -882,7 +757,6 @@ static inline SCM
make_bytevector_output_port (void) make_bytevector_output_port (void)
{ {
SCM port, proc; SCM port, proc;
scm_t_port *c_port;
scm_t_bytevector_output_port_buffer *buf; scm_t_bytevector_output_port_buffer *buf;
const unsigned long mode_bits = SCM_OPN | SCM_WRTNG; const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
@ -895,31 +769,28 @@ make_bytevector_output_port (void)
NULL, /* encoding */ NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR, SCM_FAILED_CONVERSION_ERROR,
(scm_t_bits)buf); (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); 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 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; scm_t_bytevector_output_port_buffer *buf;
buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port); buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port);
count = write_buf->end - write_buf->cur;
if (buf->pos + size > buf->total_len) if (buf->pos + count > buf->total_len)
bytevector_output_port_buffer_grow (buf, buf->pos + size); bytevector_output_port_buffer_grow (buf, buf->pos + count);
memcpy (buf->buffer + buf->pos, data, size); memcpy (buf->buffer + buf->pos, write_buf->buf + write_buf->cur, count);
buf->pos += size; buf->pos += count;
buf->len = (buf->len > buf->pos) ? buf->len : buf->pos; 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" #define FUNC_NAME "bytevector_output_port_seek"
{ {
scm_t_bytevector_output_port_buffer *buf; scm_t_bytevector_output_port_buffer *buf;
scm_t_off target;
buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port); buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port);
switch (whence)
{
case SEEK_CUR:
offset += (scm_t_off) buf->pos;
/* Fall through. */
case SEEK_SET: if (whence == SEEK_CUR)
if (offset < 0 || (unsigned) offset > buf->len) target = offset + buf->pos;
scm_out_of_range (FUNC_NAME, scm_from_int (offset)); else if (whence == SEEK_SET)
else target = offset;
buf->pos = offset; else if (whence == SEEK_END)
break; target = offset + buf->len;
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
case SEEK_END: if (target >= 0 && target <= buf->len)
if (offset < 0 || (unsigned) offset >= buf->len) buf->pos = target;
scm_out_of_range (FUNC_NAME, scm_from_int (offset)); else
else scm_out_of_range (FUNC_NAME, scm_from_long (offset));
buf->pos = buf->len - (offset + 1);
break;
default: return target;
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
"invalid `seek' parameter");
}
return buf->pos;
} }
#undef FUNC_NAME #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); buf = (scm_t_bytevector_output_port_buffer *) SCM_SMOB_DATA (proc);
if (SCM_OPPORTP (buf->port))
scm_flush (buf->port);
result_buf = *buf; result_buf = *buf;
bytevector_output_port_buffer_init (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, make_custom_binary_output_port (SCM write_proc, SCM get_position_proc,
SCM set_position_proc, SCM close_proc) SCM set_position_proc, SCM close_proc)
{ {
SCM port;
scm_t_port *c_port;
struct custom_binary_port *stream; struct custom_binary_port *stream;
const unsigned long mode_bits = SCM_OPN | SCM_WRTNG; 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 = scm_gc_typed_calloc (struct custom_binary_port);
stream->read_buffer = SCM_BOOL_F;
stream->read = SCM_BOOL_F; stream->read = SCM_BOOL_F;
stream->write = write_proc; stream->write = write_proc;
stream->get_position = get_position_proc; stream->get_position = get_position_proc;
stream->set_position_x = set_position_proc; stream->set_position_x = set_position_proc;
stream->close = close_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, mode_bits,
NULL, /* encoding */ NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR, SCM_FAILED_CONVERSION_ERROR,
(scm_t_bits) stream); (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 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" #define FUNC_NAME "custom_binary_output_port_write"
{ {
long int c_result; size_t size, written;
size_t c_written;
struct custom_binary_port *stream = (void *) SCM_STREAM (port); 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, /* FIXME: If BUF is the same as PORT->write_buf, then the data is
but necessary since (1) we don't control the lifetime of the buffer GC-managed and we could avoid allocating a new bytevector backing
pointed to by DATA, and (2) the `write!' procedure could capture the store. Otherwise we have to copy, as we do here. */
bytevector it is passed. */ size = buf->end - buf->cur;
bv = scm_c_make_bytevector (size); 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 /* 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 try hard to write exactly SIZE bytes, regardless of how many bytes the
sink can handle. */ sink can handle. */
for (c_written = 0; written = 0;
c_written < size; while (written < size)
c_written += c_result)
{ {
long int c_result;
SCM result;
result = scm_call_3 (stream->write, bv, result = scm_call_3 (stream->write, bv,
scm_from_size_t (c_written), scm_from_size_t (written),
scm_from_size_t (size - c_written)); scm_from_size_t (size - written));
c_result = scm_to_long (result); c_result = scm_to_long (result);
if (SCM_UNLIKELY (c_result < 0 if (c_result < 0 || (size_t) c_result > (size - written))
|| (size_t) c_result > (size - c_written)))
scm_wrong_type_arg_msg (FUNC_NAME, 0, result, scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
"R6RS custom binary output port `write!' " "R6RS custom binary output port `write!' "
"returned a incorrect integer"); "returned a incorrect integer");
written += c_result;
} }
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1141,118 +994,60 @@ initialize_custom_binary_output_ports (void)
static scm_t_bits transcoded_port_type = 0; 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)) #define SCM_TRANSCODED_PORT_BINARY_PORT(_port) SCM_PACK (SCM_STREAM (_port))
static inline SCM static inline SCM
make_transcoded_port (SCM binary_port, unsigned long mode) make_transcoded_port (SCM binary_port, unsigned long mode)
{ {
SCM port; SCM port;
scm_t_port *c_port;
const unsigned long mode_bits = SCM_OPN | mode; const unsigned long mode_bits = SCM_OPN | mode;
port = scm_c_make_port (transcoded_port_type, mode_bits, port = scm_c_make_port (transcoded_port_type, mode_bits,
SCM_UNPACK (binary_port)); 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; return port;
} }
static void 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 static void
transcoded_port_fill_input (SCM port) transcoded_port_read (SCM port, scm_t_port_buffer *buf)
{ {
size_t count; size_t count;
scm_t_port *c_port = SCM_PTAB_ENTRY (port); scm_t_port_buffer *bport_buf;
SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
scm_t_port *c_bport = SCM_PTAB_ENTRY (bport);
/* We can't use `scm_c_read' here, since it blocks until the whole /* We can't use `scm_c_read' here, since it blocks until the whole
block has been read or EOF. */ block has been read or EOF. */
if (c_bport->rw_active == SCM_PORT_WRITE) bport_buf = scm_fill_input (SCM_TRANSCODED_PORT_BINARY_PORT (port));
scm_force_output (bport); /* 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;
if (c_bport->read_pos >= c_bport->read_end) memcpy (buf->buf + buf->end, bport_buf->buf + bport_buf->cur, count);
scm_fill_input_unlocked (bport); bport_buf->cur += count;
buf->end += count;
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);
} }
static void static void
transcoded_port_close (SCM port) transcoded_port_close (SCM port)
{ {
SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port); scm_close_port (SCM_TRANSCODED_PORT_BINARY_PORT (port));
if (SCM_OUTPUT_PORT_P (port))
transcoded_port_flush (port);
scm_close_port (bport);
} }
static inline void static inline void
initialize_transcoded_ports (void) initialize_transcoded_ports (void)
{ {
transcoded_port_type = 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); 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_close (transcoded_port_type, transcoded_port_close);
scm_set_port_needs_close_on_gc (transcoded_port_type, 1); scm_set_port_needs_close_on_gc (transcoded_port_type, 1);
} }

12
libguile/read.c
View file

@ -2057,6 +2057,7 @@ char *
scm_i_scan_for_encoding (SCM port) scm_i_scan_for_encoding (SCM port)
{ {
scm_t_port *pt; scm_t_port *pt;
scm_t_port_buffer *buf;
char header[SCM_ENCODING_SEARCH_SIZE+1]; char header[SCM_ENCODING_SEARCH_SIZE+1];
size_t bytes_read, encoding_length, i; size_t bytes_read, encoding_length, i;
char *encoding = NULL; char *encoding = NULL;
@ -2064,6 +2065,7 @@ scm_i_scan_for_encoding (SCM port)
int in_comment; int in_comment;
pt = SCM_PTAB_ENTRY (port); pt = SCM_PTAB_ENTRY (port);
buf = pt->read_buf;
if (pt->rw_random) if (pt->rw_random)
{ {
@ -2072,13 +2074,11 @@ scm_i_scan_for_encoding (SCM port)
pt->rw_active = SCM_PORT_READ; 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. */ /* We can use the read buffer, and thus avoid a seek. */
if (scm_fill_input_unlocked (port) == EOF) buf = scm_fill_input_unlocked (port);
return NULL; bytes_read = buf->end - buf->cur;
bytes_read = pt->read_end - pt->read_pos;
if (bytes_read > SCM_ENCODING_SEARCH_SIZE) if (bytes_read > SCM_ENCODING_SEARCH_SIZE)
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. */ /* An unbuffered port -- don't scan. */
return NULL; return NULL;
memcpy (header, pt->read_pos, bytes_read); memcpy (header, buf->buf + buf->cur, bytes_read);
header[bytes_read] = '\0'; header[bytes_read] = '\0';
} }
else else

19
libguile/rw.c
View file

@ -231,22 +231,21 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
{ {
SCM port = (SCM_UNBNDP (port_or_fdes)? SCM port = (SCM_UNBNDP (port_or_fdes)?
scm_current_output_port () : port_or_fdes); scm_current_output_port () : port_or_fdes);
scm_t_port *pt; scm_t_port_buffer *write_buf;
scm_t_off space;
SCM_VALIDATE_OPFPORT (2, port); SCM_VALIDATE_OPFPORT (2, port);
SCM_VALIDATE_OUTPUT_PORT (2, port); SCM_VALIDATE_OUTPUT_PORT (2, port);
pt = SCM_PTAB_ENTRY (port); write_buf = SCM_PTAB_ENTRY (port)->write_buf;
/* filling the last character in the buffer would require a flush. */
space = pt->write_end - pt->write_pos - 1; /* Filling the last character in the buffer would require a
if (space >= write_len) flush. */
if (write_len < write_buf->size - write_buf->end)
{ {
memcpy (pt->write_pos, src, write_len); scm_c_write_unlocked (port, src, write_len);
pt->write_pos += write_len;
return scm_from_long (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); fdes = SCM_FPORT_FDES (port);
} }
{ {

275
libguile/strports.c
View file

@ -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; 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 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); size_t count;
const signed char *src = SCM_BYTEVECTOR_CONTENTS (old_stream); struct string_port *stream = (void *) SCM_STREAM (port);
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; if (stream->pos >= stream->len)
return;
pt->write_buf_size = new_size; count = stream->len - stream->pos;
if (count > dst->size - dst->end)
count = dst->size - dst->end;
memcpy (dst, src, min_size); memcpy (dst->buf + dst->end,
SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
scm_remember_upto_here_1 (old_stream); count);
dst->end += count;
/* reset buffer. */ stream->pos += count;
{
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;
}
} }
static void 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) if (SCM_BYTEVECTOR_LENGTH (stream->bytevector) < stream->pos + count)
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)
{ {
pt->read_end = (unsigned char *) pt->read_pos; SCM new_bv;
pt->read_buf_size = pt->read_end - pt->read_buf; 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 memcpy (SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
st_end_input (SCM port, int offset) src->buf + src->cur,
{ count);
scm_t_port *pt = SCM_PTAB_ENTRY (port); src->cur += count;
stream->pos += count;
if (pt->read_pos - pt->read_buf < offset) if (stream->pos > stream->len)
scm_misc_error ("st_end_input", "negative position", SCM_EOL); stream->len = stream->pos;
pt->write_pos = (unsigned char *) (pt->read_pos = pt->read_pos - offset);
} }
static scm_t_off 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; scm_t_off target;
switch (whence) if (whence == SEEK_CUR)
{ target = offset + stream->pos;
case SEEK_CUR: else if (whence == SEEK_SET)
target = pt->read_pos - pt->read_buf + offset; target = offset;
break; else if (whence == SEEK_END)
case SEEK_END: target = offset + stream->len;
target = pt->read_end - pt->read_buf + offset; else
break; scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
default: /* SEEK_SET */
target = offset;
break;
}
if (target < 0) if (target >= 0 && target <= stream->len)
scm_misc_error ("st_seek", "negative offset", SCM_EOL); stream->pos = target;
else
if (target >= pt->write_buf_size) scm_out_of_range (FUNC_NAME, scm_from_long (offset));
{
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);
}
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;
}
return target; 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. */ /* The initial size in bytes of a string port's buffer. */
#define INITIAL_BUFFER_SIZE 128 #define INITIAL_BUFFER_SIZE 128
@ -226,10 +145,9 @@ st_truncate (SCM port, scm_t_off length)
SCM SCM
scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
{ {
SCM z, buf; SCM buf;
scm_t_port *pt; size_t len, byte_pos;
size_t read_buf_size, num_bytes, c_byte_pos; struct string_port *stream;
char *c_buf;
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); 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)) if (scm_is_false (str))
{ {
/* Allocate a new buffer to write to. */ /* Allocate a new buffer to write to. */
num_bytes = INITIAL_BUFFER_SIZE; buf = scm_c_make_bytevector (INITIAL_BUFFER_SIZE);
buf = scm_c_make_bytevector (num_bytes); len = byte_pos = 0;
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;
} }
else else
{ {
char *copy;
SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
/* STR is a string. */ buf = scm_string_to_utf8 (str);
/* Create a copy of STR in UTF-8. */ len = scm_c_bytevector_length (buf);
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;
if (scm_is_eq (pos, SCM_INUM0)) if (scm_is_eq (pos, SCM_INUM0))
c_byte_pos = 0; byte_pos = 0;
else else
/* Inefficient but simple way to convert the character position /* 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), 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, stream = scm_gc_typed_calloc (struct string_port);
"UTF-8", stream->bytevector = buf;
scm_i_default_port_conversion_handler (), stream->pos = byte_pos;
SCM_UNPACK (buf)); stream->len = len;
pt = SCM_PTAB_ENTRY (z); return scm_c_make_port_with_encoding (scm_tc16_strport, modes,
"UTF-8",
pt->write_buf = pt->read_buf = (unsigned char *) c_buf; scm_i_default_port_conversion_handler (),
pt->read_pos = pt->write_pos = pt->read_buf + c_byte_pos; (scm_t_bits) stream);
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;
return z;
} }
/* Create a new string from the buffer of PORT, a string port, converting from /* 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
scm_strport_to_string (SCM port) 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_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, 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.") "by the garbage collector if it becomes inaccessible.")
#define FUNC_NAME s_scm_open_input_string #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; return p;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -473,13 +375,12 @@ scm_eval_string (SCM string)
} }
static scm_t_bits 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_t_bits tc = scm_make_port_type ("string",
string_port_read,
scm_set_port_end_input (tc, st_end_input); string_port_write);
scm_set_port_seek (tc, st_seek); scm_set_port_seek (tc, string_port_seek);
scm_set_port_truncate (tc, st_truncate);
return tc; return tc;
} }
@ -487,7 +388,7 @@ scm_make_stptob ()
void void
scm_init_strports () scm_init_strports ()
{ {
scm_tc16_strport = scm_make_stptob (); scm_tc16_strport = scm_make_string_port_type ();
#include "libguile/strports.x" #include "libguile/strports.x"
} }

103
libguile/vports.c
View file

@ -22,6 +22,7 @@
# include <config.h> # include <config.h>
#endif #endif
#include <assert.h>
#include <stdio.h> #include <stdio.h>
#include <errno.h> #include <errno.h>
@ -58,73 +59,68 @@ struct soft_port {
SCM read_char; SCM read_char;
SCM close; SCM close;
SCM input_waiting; 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 static void
soft_port_flush (SCM port) soft_port_get_natural_buffer_sizes (SCM port, size_t *read_size,
size_t *write_size)
{
*write_size = 1;
}
static void
soft_port_write (SCM port, scm_t_port_buffer *buf)
{ {
struct soft_port *stream = (void *) SCM_STREAM (port); 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;
scm_call_1 (stream->write_string, str);
/* Backwards compatibility. */
if (scm_is_true (stream->flush)) if (scm_is_true (stream->flush))
scm_call_0 (stream->flush); scm_call_0 (stream->flush);
} }
static void
soft_port_write (SCM port, const void *data, size_t size)
{
struct soft_port *stream = (void *) SCM_STREAM (port);
/* 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));
}
/* 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. */
/* places a single char in the input buffer. */ /* places a single char in the input buffer. */
static int static void
soft_port_fill_input (SCM port) soft_port_read (SCM port, scm_t_port_buffer *dst)
{ {
struct soft_port *stream = (void *) SCM_STREAM (port); struct soft_port *stream = (void *) SCM_STREAM (port);
SCM ans; scm_t_port_buffer *encode_buf = stream->encode_buf;
scm_t_wchar c;
scm_t_port_internal *pti;
ans = scm_call_0 (stream->read_char); /* A character can be more than one byte, but we don't have a
if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans)) guarantee that there is more than one byte in the read buffer. So,
return EOF; use an intermediate buffer. Terrible. This whole facility should
SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "soft_port_fill_input"); be (re)designed. */
pti = SCM_PORT_GET_INTERNAL (port); if (encode_buf->cur == encode_buf->end)
c = SCM_CHAR (ans);
if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1
|| (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8 && c < 0xff))
{ {
scm_t_port *pt = SCM_PTAB_ENTRY (port); SCM ans;
char *str;
*pt->read_buf = c; size_t len;
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); 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");
SCM_LINUM (port) = line; /* It's possible to make a fast path here, but it would be fastest
SCM_COL (port) = column; 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 #define FUNC_NAME s_scm_make_soft_port
{ {
int vlen; int vlen;
SCM z;
struct soft_port *stream; struct soft_port *stream;
SCM_VALIDATE_VECTOR (1, pv); SCM_VALIDATE_VECTOR (1, pv);
@ -216,11 +211,10 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
stream->input_waiting = stream->input_waiting =
vlen == 6 ? SCM_SIMPLE_VECTOR_REF (pv, 5) : SCM_BOOL_F; 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), stream->encode_buf = scm_c_make_port_buffer (10);
(scm_t_bits) stream);
scm_port_non_buffer (SCM_PTAB_ENTRY (z));
return z; return scm_c_make_port (scm_tc16_soft_port, scm_i_mode_bits (modes),
(scm_t_bits) stream);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -228,12 +222,13 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
static scm_t_bits static scm_t_bits
scm_make_sfptob () 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); soft_port_write);
scm_set_port_flush (tc, soft_port_flush);
scm_set_port_close (tc, soft_port_close); scm_set_port_close (tc, soft_port_close);
scm_set_port_needs_close_on_gc (tc, 1); 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); scm_set_port_input_waiting (tc, soft_port_input_waiting);
return tc; return tc;

59
test-suite/standalone/test-scm-c-read.c
View file

@ -33,52 +33,39 @@
/* Size of our port's internal buffer. */ /* Size of our port's internal buffer. */
#define PORT_BUFFER_SIZE 1024 #define PORT_BUFFER_SIZE 1024
struct custom_port
{
size_t pos;
size_t len;
char *buf;
};
/* Return a new port of type PORT_TYPE. */ /* Return a new port of type PORT_TYPE. */
static inline SCM static inline SCM
make_port (scm_t_bits port_type) make_port (scm_t_bits port_type)
{ {
SCM port; struct custom_port *stream = scm_gc_typed_calloc (struct custom_port);
char *c_buffer;
scm_t_port *c_port;
c_buffer = scm_gc_calloc (PORT_BUFFER_SIZE, "custom-port-buffer"); stream->pos = 0;
stream->len = PORT_BUFFER_SIZE;
stream->buf = scm_gc_calloc (stream->len, "custom-port-buffer");
port = scm_new_port_table_entry (port_type); return scm_c_make_port (port_type, SCM_RDNG, (scm_t_bits) stream);
/* 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;
} }
/* Read one byte from PORT. */ static void
static int custom_port_read (SCM port, scm_t_port_buffer *dst)
fill_input (SCM port)
{ {
int result; size_t to_copy = dst->size - dst->end;
scm_t_port *c_port = SCM_PTAB_ENTRY (port); struct custom_port *stream = (void *) SCM_STREAM (port);
/* Make sure that C_PORT's internal buffer wasn't changed behind our back. if (stream->pos + to_copy > stream->len)
See http://lists.gnu.org/archive/html/guile-devel/2008-11/msg00042.html to_copy = stream->len - stream->pos;
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);
if (c_port->read_pos >= c_port->read_end) memcpy (dst->buf + dst->end, stream->buf + stream->pos, to_copy);
result = EOF; stream->pos += to_copy;
else dst->end += to_copy;
result = (int) *c_port->read_pos++;
return result;
} }
/* Return true (non-zero) if BUF contains only zeros. */ /* 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)]; char buffer[PORT_BUFFER_SIZE + (PORT_BUFFER_SIZE / 2)];
size_t read, last_read; 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); port = make_port (port_type);
read = 0; read = 0;

3
test-suite/tests/r6rs-ports.test
View file

@ -789,6 +789,7 @@ not `set-port-position!'"
(port (make-custom-binary-output-port "cbop" write! (port (make-custom-binary-output-port "cbop" write!
#f #f #f))) #f #f #f)))
(put-bytevector port source) (put-bytevector port source)
(force-output port)
(and (= sink-pos (bytevector-length source)) (and (= sink-pos (bytevector-length source))
(not eof?) (not eof?)
(bytevector=? sink source)))) (bytevector=? sink source))))
@ -813,6 +814,7 @@ not `set-port-position!'"
(port (make-custom-binary-output-port "cbop" write! (port (make-custom-binary-output-port "cbop" write!
#f #f #f))) #f #f #f)))
(put-bytevector port source) (put-bytevector port source)
(force-output port)
(and (= sink-pos (bytevector-length source)) (and (= sink-pos (bytevector-length source))
(not eof?) (not eof?)
(bytevector=? sink source)))) (bytevector=? sink source))))
@ -873,6 +875,7 @@ not `set-port-position!'"
(let* ((t (make-transcoder (latin-1-codec) (native-eol-style) (let* ((t (make-transcoder (latin-1-codec) (native-eol-style)
(error-handling-mode raise))) (error-handling-mode raise)))
(tp (transcoded-port p t))) (tp (transcoded-port p t)))
(setvbuf tp 'none)
(guard (c ((i/o-encoding-error? c) (guard (c ((i/o-encoding-error? c)
(and (eq? (i/o-error-port c) tp) (and (eq? (i/o-error-port c) tp)
(char=? (i/o-encoding-error-char c) #\λ) (char=? (i/o-encoding-error-char c) #\λ)

12
test-suite/tests/web-client.test
View file

@ -471,8 +471,7 @@ Connection: close\r
(error "Port closed for writing")) (error "Port closed for writing"))
(put-u8 request-port (char->integer c))) (put-u8 request-port (char->integer c)))
(define (put-string s) (define (put-string s)
(string-for-each put-char s)) (string-for-each put-char s)
(define (flush)
(set! writing? #f) (set! writing? #f)
(set! reading? #t) (set! reading? #t)
(let* ((p (open-bytevector-input-port (get-bytevector))) (let* ((p (open-bytevector-input-port (get-bytevector)))
@ -500,8 +499,13 @@ Connection: close\r
(when writing? (when writing?
(unless (eof-object? (get-u8 response-body-port)) (unless (eof-object? (get-u8 response-body-port))
(error "Failed to consume all of body")))) (error "Failed to consume all of body"))))
(proc (make-soft-port (vector put-char put-string flush get-char close) (let ((soft-port (make-soft-port
"rw")))))) (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 (define* (check-transaction method uri
request-headers request-body request-body-encoding request-headers request-body request-body-encoding