mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Generic port facility provides buffering uniformly
* libguile/ports.h (struct scm_t_port_buffer): New data type.
(struct scm_t_port): Refactor to use port buffers instead of
implementation-managed read and write pointers. Add "read_buffering"
member.
(SCM_INITIAL_PUTBACK_BUF_SIZE, SCM_READ_BUFFER_EMPTY_P): Remove.
(scm_t_ptob_descriptor): Rename "fill_input" function to "read", and
take a port buffer, returning void. Likewise "write" takes a port
buffer and returns void. Remove "end_input"; instead if there is
buffered input and rw_random is true, then there must be a seek
function, so just seek back if needed. Remove "flush"; instead all
calls to the "write" function implicitly include a "flush", since the
buffering happens in the generic port code now. Remove "setvbuf", but
add "get_natural_buffer_sizes"; instead the generic port code can
buffer any port.
(scm_make_port_type): Adapt to read and write prototype changes.
(scm_set_port_flush, scm_set_port_end_input, scm_set_port_setvbuf):
Remove.
(scm_slow_get_byte_or_eof_unlocked)
(scm_slow_get_peek_or_eof_unlocked): Remove; the slow path is to call
scm_fill_input.
(scm_set_port_get_natural_buffer_sizes): New function.
(scm_c_make_port_buffer): New internal function.
(scm_port_non_buffer): Remove. This was a function for
implementations that is no longer needed. Instead open with BUF0 or
use (setvbuf port 'none).
(scm_fill_input, scm_fill_input_unlocked): Return the filled port
buffer.
(scm_get_byte_or_eof_unlocked, scm_peek_byte_or_eof_unlocked): Adapt
to changes in buffering and EOF management.
* libguile/ports.c: Adapt to port interface changes.
(initialize_port_buffers): New function, using the port mode flags to
set up appropriate initial buffering for all ports.
(scm_c_make_port_with_encoding): Create port buffers here instead of
delegating to implementations.
(scm_close_port): Flush the port if needed instead of delegating to
the implementation.
* libguile/filesys.c (set_element): Adapt to buffering changes.
* libguile/fports.c (fport_get_natural_buffer_sizes): New function,
replacing scm_fport_buffer_add.
(fport_write, fport_read): Update to let the generic ports code do the
buffering.
(fport_flush, fport_end_input): Remove.
(fport_close): Don't flush in a dynwind; that's the core ports' job.
(scm_make_fptob): Adapt.
* libguile/ioext.c (scm_redirect_port): Adapt to buffering changes.
* libguile/poll.c (scm_primitive_poll): Adapt to buffering changes.
* libguile/ports-internal.h (struct scm_port_internal): Remove
pending_eof flag; this is now set on the read buffer.
* libguile/r6rs-ports.c (struct bytevector_input_port): New type. The
new buffering arrangement means that there's now an intermediate
buffer between the bytevector and the user of the port; this could
lead to a perf degradation, but on the other hand there are some other
speedups enabled by the buffering refactor, so probably the memcpy
cost is dwarfed by the cost of the other parts of the ports
machinery.
(make_bytevector_input_port, bytevector_input_port_read):
(bytevector_input_port_seek, initialize_bytevector_input_ports): Adapt
to new buffering arrangement.
(struct custom_binary_port): Remove read buffer, as Guile handles that
now.
(custom_binary_input_port_setvbuf): Remove; now handled by Guile.
(make_custom_binary_input_port, custom_binary_input_port_read)
(initialize_custom_binary_input_ports): Adapt.
(scm_get_bytevector_some): Adapt to new EOF management.
(scm_t_bytevector_output_port_buffer): Hold on to the underlying port,
so we can flush it if it's open.
(make_bytevector_output_port, bytevector_output_port_write):
(bytevector_output_port_seek): Adapt.
(bytevector_output_port_procedure): Flush the port as appropriate, so
that we get all the bytes.
(make_custom_binary_output_port, custom_binary_output_port_write):
Adapt.
(make_transcoded_port): Don't muck with buffering.
(transcoded_port_write): Simply forward the write to the underlying
port.
(transcoded_port_read): Likewise.
(transcoded_port_close): No need to flush.
(initialize_transcoded_ports): Adapt.
* libguile/read.c (scm_i_scan_for_encoding): Adapt to buffering
changes.
* libguile/rw.c (scm_write_string_partial): Adapt to buffering changes.
* libguile/strports.c: Adapt to the fact that we don't manage the
buffer. Probably room for speed improvements here...
* libguile/vports.c (soft_port_get_natural_buffer_sizes): New function.
Adapt the rest of the file for the new buffering regime.
* test-suite/tests/r6rs-ports.test ("8.2.10 Output ports"): Custom
binary output ports need to be flushed before you can rely on the
write! procedure having been called. Add necessary flush-port
invocations.
("8.2.6 Input and output ports"): Transcoded ports now have an
internal buffer by default. This test checks that the characters are
transcoded one at a time, so to do that, call setvbuf on the
transcoded port to remove the buffer.
* test-suite/tests/web-client.test (run-with-http-transcript): Fix for
different flushing regime on soft ports. (The vestigial flush
procedure is now called after each write, which is not what the test
was expecting.)
* test-suite/standalone/test-scm-c-read.c: Update for changes to the C
interface for defining port types.
* doc/ref/api-io.texi (Ports): Update to discuss buffering in a generic
way, and to remove a hand-wavey paragraph describing string ports as
"interesting and powerful".
(Reading, Writing): Remove placeholder comments. Document
`scm_lfwrite'.
(Buffering): New section.
(File Ports): Link to buffering.
(I/O Extensions): Join subnodes into parent and describe new API,
including buffering API.
* doc/ref/posix.texi (Ports and File Descriptors): Link to buffering.
Remove unread-char etc, as they are documented elsewhere.
(Pipes, Network Sockets and Communication): Link to buffering.
This commit is contained in:
Andy Wingo
parent
e8eeeeb1d4
commit
8399e7af51
17 changed files with 1033 additions and 1629 deletions
|
|
@ -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
|
||||
@subsection Implementing New Port Types 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
|
||||
|
||||
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.
|
||||
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.
|
||||
|
||||
The special treatment must be performed if the @code{rw_random} flag in
|
||||
the port is non-zero.
|
||||
@subsubheading C interface
|
||||
|
||||
@subsubheading The @code{rw_active} variable
|
||||
A port type object is created by calling @code{scm_make_port_type}.
|
||||
|
||||
The @code{rw_active} variable in the port is only used if
|
||||
@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.
|
||||
@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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -690,122 +626,11 @@ fport_truncate (SCM port, scm_t_off length)
|
|||
scm_syserror ("ftruncate");
|
||||
}
|
||||
|
||||
static void
|
||||
fport_write (SCM port, const void *data, size_t size)
|
||||
#define FUNC_NAME "fport_write"
|
||||
{
|
||||
/* this procedure tries to minimize the number of writes/flushes. */
|
||||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
||||
|
||||
if (pt->write_buf == &pt->shortbuf
|
||||
|| (pt->write_pos == pt->write_buf && size >= pt->write_buf_size))
|
||||
{
|
||||
/* Unbuffered port, or port with empty buffer and data won't fit in
|
||||
buffer. */
|
||||
if (full_write (SCM_FPORT_FDES (port), data, size) < size)
|
||||
SCM_SYSERROR;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
{
|
||||
scm_t_off space = pt->write_end - pt->write_pos;
|
||||
|
||||
if (size <= space)
|
||||
{
|
||||
/* data fits in buffer. */
|
||||
memcpy (pt->write_pos, data, size);
|
||||
pt->write_pos += size;
|
||||
if (pt->write_pos == pt->write_end)
|
||||
{
|
||||
fport_flush (port);
|
||||
/* we can skip the line-buffering check if nothing's buffered. */
|
||||
return;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
memcpy (pt->write_pos, data, space);
|
||||
pt->write_pos = pt->write_end;
|
||||
fport_flush (port);
|
||||
{
|
||||
const void *ptr = ((const char *) data) + space;
|
||||
size_t remaining = size - space;
|
||||
|
||||
if (size >= pt->write_buf_size)
|
||||
{
|
||||
if (full_write (SCM_FPORT_FDES (port), ptr, remaining)
|
||||
< remaining)
|
||||
SCM_SYSERROR;
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
memcpy (pt->write_pos, ptr, remaining);
|
||||
pt->write_pos += remaining;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static void
|
||||
fport_flush (SCM port)
|
||||
{
|
||||
size_t written;
|
||||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
||||
scm_t_fport *fp = SCM_FSTREAM (port);
|
||||
size_t count = pt->write_pos - pt->write_buf;
|
||||
|
||||
written = full_write (fp->fdes, pt->write_buf, count);
|
||||
if (written < count)
|
||||
scm_syserror ("scm_flush");
|
||||
|
||||
pt->write_pos = pt->write_buf;
|
||||
}
|
||||
|
||||
/* clear the read buffer and adjust the file position for unread bytes. */
|
||||
static void
|
||||
fport_end_input (SCM port, int offset)
|
||||
{
|
||||
scm_t_fport *fp = SCM_FSTREAM (port);
|
||||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
||||
|
||||
offset += pt->read_end - pt->read_pos;
|
||||
|
||||
if (offset > 0)
|
||||
{
|
||||
pt->read_pos = pt->read_end;
|
||||
/* will throw error if unread-char used at beginning of file
|
||||
then attempting to write. seems correct. */
|
||||
if (lseek (fp->fdes, -offset, SEEK_CUR) == -1)
|
||||
scm_syserror ("fport_end_input");
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
close_the_fd (void *data)
|
||||
{
|
||||
scm_t_fport *fp = data;
|
||||
|
||||
close (fp->fdes);
|
||||
/* There's already one exception. That's probably enough! */
|
||||
errno = 0;
|
||||
}
|
||||
|
||||
static void
|
||||
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_t_bits tc = scm_make_port_type ("file", fport_read, fport_write);
|
||||
|
||||
scm_set_port_needs_close_on_gc (tc, 1);
|
||||
scm_set_port_print (tc, fport_print);
|
||||
scm_set_port_flush (tc, fport_flush);
|
||||
scm_set_port_end_input (tc, fport_end_input);
|
||||
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_setvbuf (tc, scm_fport_buffer_add);
|
||||
scm_set_port_get_natural_buffer_sizes (tc, fport_get_natural_buffer_sizes);
|
||||
|
||||
return tc;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
/* 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);
|
||||
|
||||
/* must flush to old fdes. */
|
||||
if (pt->rw_active == SCM_PORT_WRITE)
|
||||
if (SCM_OUTPUT_PORT_P (new))
|
||||
scm_flush_unlocked (new);
|
||||
else if (pt->rw_active == SCM_PORT_READ)
|
||||
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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
};
|
||||
|
||||
|
|
|
|||
704
libguile/ports.c
704
libguile/ports.c
File diff suppressed because it is too large
Load diff
208
libguile/ports.h
208
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;
|
||||
|
||||
/* pointer to internal-only port structure */
|
||||
/* A recursive lock for this port. */
|
||||
scm_i_pthread_mutex_t *lock;
|
||||
|
||||
/* Pointer to internal-only port structure. */
|
||||
struct scm_port_internal *internal;
|
||||
|
||||
/* 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. */
|
||||
/* Source location information. */
|
||||
SCM file_name;
|
||||
long line_number;
|
||||
int column_number;
|
||||
|
||||
/* 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. */
|
||||
/* Port buffers. */
|
||||
scm_t_port_buffer *read_buf;
|
||||
scm_t_port_buffer *write_buf;
|
||||
|
||||
/* 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. */
|
||||
/* 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;
|
||||
|
||||
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. */
|
||||
/* 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;
|
||||
|
||||
/* 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;
|
||||
/* 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;
|
||||
|
||||
/* 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 */
|
||||
/* 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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
|
||||
scm_t_off target;
|
||||
|
||||
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;
|
||||
}
|
||||
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_out_of_range (FUNC_NAME, scm_from_int (offset));
|
||||
break;
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
|
||||
|
||||
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;
|
||||
}
|
||||
if (target >= 0 && target <= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
|
||||
stream->pos = target;
|
||||
else
|
||||
scm_out_of_range (FUNC_NAME, scm_from_int (offset));
|
||||
break;
|
||||
scm_out_of_range (FUNC_NAME, scm_from_long (offset));
|
||||
|
||||
default:
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
|
||||
"invalid `seek' parameter");
|
||||
}
|
||||
|
||||
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;
|
||||
size_t c_octets;
|
||||
|
||||
c_requested = c_port->read_buf_size;
|
||||
/* 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));
|
||||
|
||||
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));
|
||||
octets = scm_call_3 (stream->read, bv, SCM_INUM0, scm_bytevector_length (bv));
|
||||
c_octets = scm_to_size_t (octets);
|
||||
if (SCM_UNLIKELY (c_octets > c_requested))
|
||||
if (c_octets > scm_c_bytevector_length (bv))
|
||||
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;
|
||||
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)
|
||||
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));
|
||||
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
|
||||
buf->pos = offset;
|
||||
break;
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
|
||||
|
||||
case SEEK_END:
|
||||
if (offset < 0 || (unsigned) offset >= buf->len)
|
||||
scm_out_of_range (FUNC_NAME, scm_from_int (offset));
|
||||
if (target >= 0 && target <= buf->len)
|
||||
buf->pos = target;
|
||||
else
|
||||
buf->pos = buf->len - (offset + 1);
|
||||
break;
|
||||
scm_out_of_range (FUNC_NAME, scm_from_long (offset));
|
||||
|
||||
default:
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
|
||||
"invalid `seek' parameter");
|
||||
}
|
||||
|
||||
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);
|
||||
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;
|
||||
|
||||
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);
|
||||
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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -231,21 +231,20 @@ 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);
|
||||
fdes = SCM_FPORT_FDES (port);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
static void
|
||||
string_port_read (SCM port, scm_t_port_buffer *dst)
|
||||
{
|
||||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
||||
size_t count;
|
||||
struct string_port *stream = (void *) SCM_STREAM (port);
|
||||
|
||||
if (pt->read_pos >= pt->read_end)
|
||||
return EOF;
|
||||
else
|
||||
return *pt->read_pos;
|
||||
if (stream->pos >= stream->len)
|
||||
return;
|
||||
|
||||
count = stream->len - stream->pos;
|
||||
if (count > dst->size - dst->end)
|
||||
count = dst->size - dst->end;
|
||||
|
||||
memcpy (dst->buf + dst->end,
|
||||
SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
|
||||
count);
|
||||
dst->end += count;
|
||||
stream->pos += count;
|
||||
}
|
||||
|
||||
/* 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_write (SCM port, scm_t_port_buffer *src)
|
||||
{
|
||||
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);
|
||||
struct string_port *stream = (void *) SCM_STREAM (port);
|
||||
size_t count = src->end - src->cur;
|
||||
|
||||
scm_t_off offset = pt->write_pos - pt->write_buf;
|
||||
|
||||
pt->write_buf_size = new_size;
|
||||
|
||||
memcpy (dst, src, min_size);
|
||||
|
||||
scm_remember_upto_here_1 (old_stream);
|
||||
|
||||
/* reset buffer. */
|
||||
if (SCM_BYTEVECTOR_LENGTH (stream->bytevector) < stream->pos + count)
|
||||
{
|
||||
pt->stream = SCM_UNPACK (new_stream);
|
||||
pt->read_buf = pt->write_buf = (unsigned char *)dst;
|
||||
pt->read_pos = pt->write_pos = pt->write_buf + offset;
|
||||
pt->write_end = pt->write_buf + pt->write_buf_size;
|
||||
pt->read_end = pt->read_buf + pt->read_buf_size;
|
||||
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_write (SCM port, const void *data, size_t size)
|
||||
{
|
||||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
||||
|
||||
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)
|
||||
{
|
||||
pt->read_end = (unsigned char *) pt->read_pos;
|
||||
pt->read_buf_size = pt->read_end - pt->read_buf;
|
||||
}
|
||||
}
|
||||
|
||||
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 */
|
||||
if (whence == SEEK_CUR)
|
||||
target = offset + stream->pos;
|
||||
else if (whence == SEEK_SET)
|
||||
target = offset;
|
||||
break;
|
||||
}
|
||||
else if (whence == SEEK_END)
|
||||
target = offset + stream->len;
|
||||
else
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
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,
|
||||
stream = scm_gc_typed_calloc (struct string_port);
|
||||
stream->bytevector = buf;
|
||||
stream->pos = byte_pos;
|
||||
stream->len = len;
|
||||
|
||||
return 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;
|
||||
|
||||
return z;
|
||||
(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"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
*write_size = 1;
|
||||
}
|
||||
|
||||
static void
|
||||
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;
|
||||
|
||||
scm_call_1 (stream->write_string, str);
|
||||
|
||||
/* Backwards compatibility. */
|
||||
if (scm_is_true (stream->flush))
|
||||
scm_call_0 (stream->flush);
|
||||
}
|
||||
|
||||
static void
|
||||
soft_port_write (SCM port, const void *data, size_t size)
|
||||
{
|
||||
struct soft_port *stream = (void *) SCM_STREAM (port);
|
||||
|
||||
/* DATA is assumed to be a locale-encoded C string, which makes it
|
||||
hard to reliably pass binary data to a soft port. It can be
|
||||
achieved by choosing a Latin-1 locale, though, but the recommended
|
||||
approach is to use an R6RS "custom binary output port" instead. */
|
||||
scm_call_1 (stream->write_string,
|
||||
scm_from_locale_stringn ((char *) data, size));
|
||||
}
|
||||
|
||||
/* calling the flush proc (element 2) is in case old code needs it,
|
||||
but perhaps softports could the use port buffer in the same way as
|
||||
fports. */
|
||||
|
||||
/* places a single char in the input buffer. */
|
||||
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_t_port_buffer *encode_buf = stream->encode_buf;
|
||||
|
||||
/* 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 ans;
|
||||
scm_t_wchar c;
|
||||
scm_t_port_internal *pti;
|
||||
char *str;
|
||||
size_t len;
|
||||
|
||||
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);
|
||||
return;
|
||||
SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "soft_port_read");
|
||||
|
||||
c = SCM_CHAR (ans);
|
||||
|
||||
if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1
|
||||
|| (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8 && c < 0xff))
|
||||
{
|
||||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
||||
|
||||
*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;
|
||||
/* 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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
struct custom_port *stream = scm_gc_typed_calloc (struct custom_port);
|
||||
|
||||
c_buffer = scm_gc_calloc (PORT_BUFFER_SIZE, "custom-port-buffer");
|
||||
stream->pos = 0;
|
||||
stream->len = PORT_BUFFER_SIZE;
|
||||
stream->buf = scm_gc_calloc (stream->len, "custom-port-buffer");
|
||||
|
||||
port = scm_new_port_table_entry (port_type);
|
||||
|
||||
/* 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);
|
||||
size_t to_copy = dst->size - dst->end;
|
||||
struct custom_port *stream = (void *) SCM_STREAM (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);
|
||||
if (stream->pos + to_copy > stream->len)
|
||||
to_copy = stream->len - stream->pos;
|
||||
|
||||
if (c_port->read_pos >= c_port->read_end)
|
||||
result = EOF;
|
||||
else
|
||||
result = (int) *c_port->read_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;
|
||||
|
|
|
|||
|
|
@ -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) #\λ)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue