mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
* libguile/ports.h (struct scm_t_port_buffer): New data type. (struct scm_t_port): Refactor to use port buffers instead of implementation-managed read and write pointers. Add "read_buffering" member. (SCM_INITIAL_PUTBACK_BUF_SIZE, SCM_READ_BUFFER_EMPTY_P): Remove. (scm_t_ptob_descriptor): Rename "fill_input" function to "read", and take a port buffer, returning void. Likewise "write" takes a port buffer and returns void. Remove "end_input"; instead if there is buffered input and rw_random is true, then there must be a seek function, so just seek back if needed. Remove "flush"; instead all calls to the "write" function implicitly include a "flush", since the buffering happens in the generic port code now. Remove "setvbuf", but add "get_natural_buffer_sizes"; instead the generic port code can buffer any port. (scm_make_port_type): Adapt to read and write prototype changes. (scm_set_port_flush, scm_set_port_end_input, scm_set_port_setvbuf): Remove. (scm_slow_get_byte_or_eof_unlocked) (scm_slow_get_peek_or_eof_unlocked): Remove; the slow path is to call scm_fill_input. (scm_set_port_get_natural_buffer_sizes): New function. (scm_c_make_port_buffer): New internal function. (scm_port_non_buffer): Remove. This was a function for implementations that is no longer needed. Instead open with BUF0 or use (setvbuf port 'none). (scm_fill_input, scm_fill_input_unlocked): Return the filled port buffer. (scm_get_byte_or_eof_unlocked, scm_peek_byte_or_eof_unlocked): Adapt to changes in buffering and EOF management. * libguile/ports.c: Adapt to port interface changes. (initialize_port_buffers): New function, using the port mode flags to set up appropriate initial buffering for all ports. (scm_c_make_port_with_encoding): Create port buffers here instead of delegating to implementations. (scm_close_port): Flush the port if needed instead of delegating to the implementation. * libguile/filesys.c (set_element): Adapt to buffering changes. * libguile/fports.c (fport_get_natural_buffer_sizes): New function, replacing scm_fport_buffer_add. (fport_write, fport_read): Update to let the generic ports code do the buffering. (fport_flush, fport_end_input): Remove. (fport_close): Don't flush in a dynwind; that's the core ports' job. (scm_make_fptob): Adapt. * libguile/ioext.c (scm_redirect_port): Adapt to buffering changes. * libguile/poll.c (scm_primitive_poll): Adapt to buffering changes. * libguile/ports-internal.h (struct scm_port_internal): Remove pending_eof flag; this is now set on the read buffer. * libguile/r6rs-ports.c (struct bytevector_input_port): New type. The new buffering arrangement means that there's now an intermediate buffer between the bytevector and the user of the port; this could lead to a perf degradation, but on the other hand there are some other speedups enabled by the buffering refactor, so probably the memcpy cost is dwarfed by the cost of the other parts of the ports machinery. (make_bytevector_input_port, bytevector_input_port_read): (bytevector_input_port_seek, initialize_bytevector_input_ports): Adapt to new buffering arrangement. (struct custom_binary_port): Remove read buffer, as Guile handles that now. (custom_binary_input_port_setvbuf): Remove; now handled by Guile. (make_custom_binary_input_port, custom_binary_input_port_read) (initialize_custom_binary_input_ports): Adapt. (scm_get_bytevector_some): Adapt to new EOF management. (scm_t_bytevector_output_port_buffer): Hold on to the underlying port, so we can flush it if it's open. (make_bytevector_output_port, bytevector_output_port_write): (bytevector_output_port_seek): Adapt. (bytevector_output_port_procedure): Flush the port as appropriate, so that we get all the bytes. (make_custom_binary_output_port, custom_binary_output_port_write): Adapt. (make_transcoded_port): Don't muck with buffering. (transcoded_port_write): Simply forward the write to the underlying port. (transcoded_port_read): Likewise. (transcoded_port_close): No need to flush. (initialize_transcoded_ports): Adapt. * libguile/read.c (scm_i_scan_for_encoding): Adapt to buffering changes. * libguile/rw.c (scm_write_string_partial): Adapt to buffering changes. * libguile/strports.c: Adapt to the fact that we don't manage the buffer. Probably room for speed improvements here... * libguile/vports.c (soft_port_get_natural_buffer_sizes): New function. Adapt the rest of the file for the new buffering regime. * test-suite/tests/r6rs-ports.test ("8.2.10 Output ports"): Custom binary output ports need to be flushed before you can rely on the write! procedure having been called. Add necessary flush-port invocations. ("8.2.6 Input and output ports"): Transcoded ports now have an internal buffer by default. This test checks that the characters are transcoded one at a time, so to do that, call setvbuf on the transcoded port to remove the buffer. * test-suite/tests/web-client.test (run-with-http-transcript): Fix for different flushing regime on soft ports. (The vestigial flush procedure is now called after each write, which is not what the test was expecting.) * test-suite/standalone/test-scm-c-read.c: Update for changes to the C interface for defining port types. * doc/ref/api-io.texi (Ports): Update to discuss buffering in a generic way, and to remove a hand-wavey paragraph describing string ports as "interesting and powerful". (Reading, Writing): Remove placeholder comments. Document `scm_lfwrite'. (Buffering): New section. (File Ports): Link to buffering. (I/O Extensions): Join subnodes into parent and describe new API, including buffering API. * doc/ref/posix.texi (Ports and File Descriptors): Link to buffering. Remove unread-char etc, as they are documented elsewhere. (Pipes, Network Sockets and Communication): Link to buffering.
318 lines
8.6 KiB
C
318 lines
8.6 KiB
C
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006,
|
||
* 2011, 2014 Free Software Foundation, Inc.
|
||
*
|
||
* This library is free software; you can redistribute it and/or
|
||
* modify it under the terms of the GNU Lesser General Public License
|
||
* as published by the Free Software Foundation; either version 3 of
|
||
* the License, or (at your option) any later version.
|
||
*
|
||
* This library is distributed in the hope that it will be useful, but
|
||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
* Lesser General Public License for more details.
|
||
*
|
||
* You should have received a copy of the GNU Lesser General Public
|
||
* License along with this library; if not, write to the Free Software
|
||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||
* 02110-1301 USA
|
||
*/
|
||
|
||
|
||
|
||
|
||
#ifdef HAVE_CONFIG_H
|
||
# include <config.h>
|
||
#endif
|
||
|
||
#include <stdio.h>
|
||
#include <errno.h>
|
||
|
||
#include "libguile/_scm.h"
|
||
#include "libguile/dynwind.h"
|
||
#include "libguile/feature.h"
|
||
#include "libguile/fports.h"
|
||
#include "libguile/hashtab.h"
|
||
#include "libguile/ioext.h"
|
||
#include "libguile/ports.h"
|
||
#include "libguile/strings.h"
|
||
#include "libguile/validate.h"
|
||
|
||
#include <fcntl.h>
|
||
|
||
#ifdef HAVE_IO_H
|
||
#include <io.h>
|
||
#endif
|
||
#include <unistd.h>
|
||
|
||
|
||
SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0,
|
||
(SCM fd_port),
|
||
"Return an integer representing the current position of\n"
|
||
"@var{fd_port}, measured from the beginning. Equivalent to:\n"
|
||
"\n"
|
||
"@lisp\n"
|
||
"(seek port 0 SEEK_CUR)\n"
|
||
"@end lisp")
|
||
#define FUNC_NAME s_scm_ftell
|
||
{
|
||
return scm_seek (fd_port, SCM_INUM0, scm_from_int (SEEK_CUR));
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
|
||
(SCM old, SCM new),
|
||
"This procedure takes two ports and duplicates the underlying file\n"
|
||
"descriptor from @var{old} into @var{new}. The\n"
|
||
"current file descriptor in @var{new} will be closed.\n"
|
||
"After the redirection the two ports will share a file position\n"
|
||
"and file status flags.\n\n"
|
||
"The return value is unspecified.\n\n"
|
||
"Unexpected behaviour can result if both ports are subsequently used\n"
|
||
"and the original and/or duplicate ports are buffered.\n\n"
|
||
"This procedure does not have any side effects on other ports or\n"
|
||
"revealed counts.")
|
||
#define FUNC_NAME s_scm_redirect_port
|
||
{
|
||
int ans, oldfd, newfd;
|
||
scm_t_fport *fp;
|
||
|
||
old = SCM_COERCE_OUTPORT (old);
|
||
new = SCM_COERCE_OUTPORT (new);
|
||
|
||
SCM_VALIDATE_OPFPORT (1, old);
|
||
SCM_VALIDATE_OPFPORT (2, new);
|
||
oldfd = SCM_FPORT_FDES (old);
|
||
fp = SCM_FSTREAM (new);
|
||
newfd = fp->fdes;
|
||
if (oldfd != newfd)
|
||
{
|
||
/* 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;
|
||
|
||
SCM_PTAB_ENTRY (new)->rw_random = SCM_PTAB_ENTRY (old)->rw_random;
|
||
}
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0,
|
||
(SCM fd_or_port, SCM fd),
|
||
"Return a new integer file descriptor referring to the open file\n"
|
||
"designated by @var{fd_or_port}, which must be either an open\n"
|
||
"file port or a file descriptor.")
|
||
#define FUNC_NAME s_scm_dup_to_fdes
|
||
{
|
||
int oldfd, newfd, rv;
|
||
|
||
fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
|
||
|
||
if (scm_is_integer (fd_or_port))
|
||
oldfd = scm_to_int (fd_or_port);
|
||
else
|
||
{
|
||
SCM_VALIDATE_OPFPORT (1, fd_or_port);
|
||
oldfd = SCM_FPORT_FDES (fd_or_port);
|
||
}
|
||
|
||
if (SCM_UNBNDP (fd))
|
||
{
|
||
newfd = dup (oldfd);
|
||
if (newfd == -1)
|
||
SCM_SYSERROR;
|
||
fd = scm_from_int (newfd);
|
||
}
|
||
else
|
||
{
|
||
newfd = scm_to_int (fd);
|
||
if (oldfd != newfd)
|
||
{
|
||
scm_evict_ports (newfd); /* see scsh manual. */
|
||
rv = dup2 (oldfd, newfd);
|
||
if (rv == -1)
|
||
SCM_SYSERROR;
|
||
}
|
||
}
|
||
return fd;
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
|
||
SCM_DEFINE (scm_dup2, "dup2", 2, 0, 0,
|
||
(SCM oldfd, SCM newfd),
|
||
"A simple wrapper for the @code{dup2} system call.\n"
|
||
"Copies the file descriptor @var{oldfd} to descriptor\n"
|
||
"number @var{newfd}, replacing the previous meaning\n"
|
||
"of @var{newfd}. Both @var{oldfd} and @var{newfd} must\n"
|
||
"be integers.\n"
|
||
"Unlike for dup->fdes or primitive-move->fdes, no attempt\n"
|
||
"is made to move away ports which are using @var{newfd}.\n"
|
||
"The return value is unspecified.")
|
||
#define FUNC_NAME s_scm_dup2
|
||
{
|
||
int c_oldfd;
|
||
int c_newfd;
|
||
int rv;
|
||
|
||
c_oldfd = scm_to_int (oldfd);
|
||
c_newfd = scm_to_int (newfd);
|
||
rv = dup2 (c_oldfd, c_newfd);
|
||
if (rv == -1)
|
||
SCM_SYSERROR;
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0,
|
||
(SCM port),
|
||
"Return the integer file descriptor underlying @var{port}. Does\n"
|
||
"not change its revealed count.")
|
||
#define FUNC_NAME s_scm_fileno
|
||
{
|
||
port = SCM_COERCE_OUTPORT (port);
|
||
SCM_VALIDATE_OPFPORT (1, port);
|
||
return scm_from_int (SCM_FPORT_FDES (port));
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
/* GJB:FIXME:: why does this not throw
|
||
an error if the arg is not a port?
|
||
This proc as is would be better names isattyport?
|
||
if it is not going to assume that the arg is a port
|
||
|
||
[cmm] I don't see any problem with the above. why should a type
|
||
predicate assume _anything_ about its argument?
|
||
*/
|
||
SCM_DEFINE (scm_isatty_p, "isatty?", 1, 0, 0,
|
||
(SCM port),
|
||
"Return @code{#t} if @var{port} is using a serial non--file\n"
|
||
"device, otherwise @code{#f}.")
|
||
#define FUNC_NAME s_scm_isatty_p
|
||
{
|
||
int rv;
|
||
|
||
port = SCM_COERCE_OUTPORT (port);
|
||
|
||
if (!SCM_OPFPORTP (port))
|
||
return SCM_BOOL_F;
|
||
|
||
rv = isatty (SCM_FPORT_FDES (port));
|
||
return scm_from_bool(rv);
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
|
||
|
||
SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0,
|
||
(SCM fdes, SCM modes),
|
||
"Return a new port based on the file descriptor @var{fdes}.\n"
|
||
"Modes are given by the string @var{modes}. The revealed count\n"
|
||
"of the port is initialized to zero. The modes string is the\n"
|
||
"same as that accepted by @ref{File Ports, open-file}.")
|
||
#define FUNC_NAME s_scm_fdopen
|
||
{
|
||
return scm_i_fdes_to_port (scm_to_int (fdes),
|
||
scm_i_mode_bits (modes), SCM_BOOL_F);
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
|
||
|
||
/* Move a port's underlying file descriptor to a given value.
|
||
* Returns #f if fdes is already the given value.
|
||
* #t if fdes moved.
|
||
* MOVE->FDES is implemented in Scheme and calls this primitive.
|
||
*/
|
||
SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
|
||
(SCM port, SCM fd),
|
||
"Moves the underlying file descriptor for @var{port} to the integer\n"
|
||
"value @var{fd} without changing the revealed count of @var{port}.\n"
|
||
"Any other ports already using this descriptor will be automatically\n"
|
||
"shifted to new descriptors and their revealed counts reset to zero.\n"
|
||
"The return value is @code{#f} if the file descriptor already had the\n"
|
||
"required value or @code{#t} if it was moved.")
|
||
#define FUNC_NAME s_scm_primitive_move_to_fdes
|
||
{
|
||
scm_t_fport *stream;
|
||
int old_fd;
|
||
int new_fd;
|
||
int rv;
|
||
|
||
port = SCM_COERCE_OUTPORT (port);
|
||
|
||
SCM_VALIDATE_OPFPORT (1, port);
|
||
stream = SCM_FSTREAM (port);
|
||
old_fd = stream->fdes;
|
||
new_fd = scm_to_int (fd);
|
||
if (old_fd == new_fd)
|
||
{
|
||
return SCM_BOOL_F;
|
||
}
|
||
scm_evict_ports (new_fd);
|
||
rv = dup2 (old_fd, new_fd);
|
||
if (rv == -1)
|
||
SCM_SYSERROR;
|
||
stream->fdes = new_fd;
|
||
SCM_SYSCALL (close (old_fd));
|
||
return SCM_BOOL_T;
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
static SCM
|
||
get_matching_port (void *closure, SCM port, SCM result)
|
||
{
|
||
int fd = * (int *) closure;
|
||
scm_t_port *entry = SCM_PTAB_ENTRY (port);
|
||
|
||
if (SCM_OPFPORTP (port)
|
||
&& ((scm_t_fport *) entry->stream)->fdes == fd)
|
||
result = scm_cons (port, result);
|
||
|
||
return result;
|
||
}
|
||
|
||
/* Return a list of ports using a given file descriptor. */
|
||
SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
|
||
(SCM fd),
|
||
"Return a list of existing ports which have @var{fd} as an\n"
|
||
"underlying file descriptor, without changing their revealed\n"
|
||
"counts.")
|
||
#define FUNC_NAME s_scm_fdes_to_ports
|
||
{
|
||
SCM result = SCM_EOL;
|
||
int int_fd = scm_to_int (fd);
|
||
|
||
result = scm_c_weak_set_fold (get_matching_port,
|
||
(void*) &int_fd, result,
|
||
scm_i_port_weak_set);
|
||
return result;
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
|
||
void
|
||
scm_init_ioext ()
|
||
{
|
||
scm_add_feature ("i/o-extensions");
|
||
|
||
#include "libguile/ioext.x"
|
||
}
|
||
|
||
|
||
/*
|
||
Local Variables:
|
||
c-file-style: "gnu"
|
||
End:
|
||
*/
|