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