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