X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/e9b8556ec92039396e740620238d56a3748f2a99..bc8e6d7d8ca602c86591466f5e9d816a614700f5:/libguile/fports.c diff --git a/libguile/fports.c b/libguile/fports.c index f4c07af0d..5549bb124 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,75 +1,63 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. - * +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, + * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, + * 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 2.1 of the License, or (at your option) any later version. + * 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 + * 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 + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ #define _LARGEFILE64_SOURCE /* ask for stat64 etc */ +#define _GNU_SOURCE /* ask for LONG_LONG_MAX/LONG_LONG_MIN */ -#if HAVE_CONFIG_H +#ifdef HAVE_CONFIG_H # include #endif #include #include -#include "libguile/_scm.h" -#include "libguile/strings.h" -#include "libguile/validate.h" -#include "libguile/gc.h" -#include "libguile/posix.h" -#include "libguile/dynwind.h" - -#include "libguile/fports.h" #ifdef HAVE_STRING_H #include #endif -#ifdef HAVE_UNISTD_H #include -#endif #ifdef HAVE_IO_H #include #endif #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE #include #endif - +#include #include #include +#include +#include -#include "libguile/iselect.h" - -/* Some defines for Windows (native port, not Cygwin). */ -#ifdef __MINGW32__ -# include -# include -#endif /* __MINGW32__ */ - -/* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize - already, but have this code here in case that wasn't so in past versions, - or perhaps to help other minimal DOS environments. +#include - gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which - might be possibilities if we've got other systems without ftruncate. */ +#include "libguile/_scm.h" +#include "libguile/strings.h" +#include "libguile/validate.h" +#include "libguile/gc.h" +#include "libguile/posix.h" +#include "libguile/dynwind.h" +#include "libguile/hashtab.h" -#if HAVE_CHSIZE && ! HAVE_FTRUNCATE -# define ftruncate(fd, size) chsize (fd, size) -#undef HAVE_FTRUNCATE -#define HAVE_FTRUNCATE 1 -#endif +#include "libguile/fports.h" +#include "libguile/ports-internal.h" #if SIZEOF_OFF_T == SIZEOF_INT #define OFF_T_MAX INT_MAX @@ -90,10 +78,10 @@ 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 buffer with specified sizes (or -1 to use default size or - 0 for no buffer. */ +/* 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, int write_size) +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); @@ -159,16 +147,27 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, "@item _IOFBF\n" "block buffered, using a newly allocated buffer of @var{size} bytes.\n" "If @var{size} is omitted, a default size will be used.\n" - "@end table") + "@end table\n\n" + "Only certain types of ports are supported, most importantly\n" + "file ports.") #define FUNC_NAME s_scm_setvbuf { int cmode; long csize; + size_t ndrained; + char *drained; scm_t_port *pt; + scm_t_port_internal *pti; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); + pti = SCM_PORT_GET_INTERNAL (port); + + if (pti->setvbuf == NULL) + scm_wrong_type_arg_msg (FUNC_NAME, 1, port, + "port that supports 'setvbuf'"); + cmode = scm_to_int (mode); if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF) scm_out_of_range (FUNC_NAME, mode); @@ -179,9 +178,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, cmode = _IOFBF; } else - { - SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~(scm_t_bits)SCM_BUFLINE); - } + SCM_SET_CELL_WORD_0 (port, + SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE); if (SCM_UNBNDP (size)) { @@ -199,7 +197,26 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, pt = SCM_PTAB_ENTRY (port); - /* silently discards buffered and put-back chars. */ + if (SCM_INPUT_PORT_P (port)) + { + /* 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); + } + } + else + ndrained = 0; + + if (SCM_OUTPUT_PORT_P (port)) + scm_flush (port); + if (pt->read_buf == pt->putback_buf) { pt->read_buf = pt->saved_read_buf; @@ -207,12 +224,13 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, pt->read_end = pt->saved_read_end; pt->read_buf_size = pt->saved_read_buf_size; } - if (pt->read_buf != &pt->shortbuf) - scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer"); - if (pt->write_buf != &pt->shortbuf) - scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer"); - scm_fport_buffer_add (port, csize, csize); + pti->setvbuf (port, csize, csize); + + if (ndrained > 0) + /* Put DRAINED back to PORT. */ + scm_unget_bytes ((unsigned char *) drained, ndrained, port); + return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -220,33 +238,35 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, /* Move ports with the specified file descriptor to new descriptors, * resetting the revealed count to 0. */ - -void -scm_evict_ports (int fd) +static void +scm_i_evict_port (void *closure, SCM port) { - long i; - - scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); + int fd = * (int*) closure; - for (i = 0; i < scm_i_port_table_size; i++) + if (SCM_FPORTP (port)) { - SCM port = scm_i_port_table[i]->port; + scm_t_port *p; + scm_t_fport *fp; - if (SCM_FPORTP (port)) - { - scm_t_fport *fp = SCM_FSTREAM (port); + /* XXX: In some cases, we can encounter a port with no associated ptab + entry. */ + p = SCM_PTAB_ENTRY (port); + fp = (p != NULL) ? (scm_t_fport *) p->stream : NULL; - if (fp->fdes == fd) - { - fp->fdes = dup (fd); - if (fp->fdes == -1) - scm_syserror ("scm_evict_ports"); - scm_set_port_revealed_x (port, scm_from_int (0)); - } + if ((fp != NULL) && (fp->fdes == fd)) + { + fp->fdes = dup (fd); + if (fp->fdes == -1) + scm_syserror ("scm_evict_ports"); + scm_set_port_revealed_x (port, scm_from_int (0)); } } +} - scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); +void +scm_evict_ports (int fd) +{ + scm_c_port_for_each (scm_i_evict_port, (void *) &fd); } @@ -260,63 +280,73 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0, #undef FUNC_NAME -/* scm_open_file - * Return a new port open on a given file. - * - * The mode string must match the pattern: [rwa+]** which - * is interpreted in the usual unix way. - * - * Return the new port. - */ -SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, - (SCM filename, SCM mode), - "Open the file whose name is @var{filename}, and return a port\n" - "representing that file. The attributes of the port are\n" - "determined by the @var{mode} string. The way in which this is\n" - "interpreted is similar to C stdio. The first character must be\n" - "one of the following:\n" - "@table @samp\n" - "@item r\n" - "Open an existing file for input.\n" - "@item w\n" - "Open a file for output, creating it if it doesn't already exist\n" - "or removing its contents if it does.\n" - "@item a\n" - "Open a file for output, creating it if it doesn't already\n" - "exist. All writes to the port will go to the end of the file.\n" - "The \"append mode\" can be turned off while the port is in use\n" - "@pxref{Ports and File Descriptors, fcntl}\n" - "@end table\n" - "The following additional characters can be appended:\n" - "@table @samp\n" - "@item b\n" - "Open the underlying file in binary mode, if supported by the operating system. " - "@item +\n" - "Open the port for both input and output. E.g., @code{r+}: open\n" - "an existing file for both input and output.\n" - "@item 0\n" - "Create an \"unbuffered\" port. In this case input and output\n" - "operations are passed directly to the underlying port\n" - "implementation without additional buffering. This is likely to\n" - "slow down I/O operations. The buffering mode can be changed\n" - "while a port is in use @pxref{Ports and File Descriptors,\n" - "setvbuf}\n" - "@item l\n" - "Add line-buffering to the port. The port output buffer will be\n" - "automatically flushed whenever a newline character is written.\n" - "@end table\n" - "In theory we could create read/write ports which were buffered\n" - "in one direction only. However this isn't included in the\n" - "current interfaces. If a file cannot be opened with the access\n" - "requested, @code{open-file} throws an exception.") -#define FUNC_NAME s_scm_open_file +static SCM sys_file_port_name_canonicalization; +SCM_SYMBOL (sym_relative, "relative"); +SCM_SYMBOL (sym_absolute, "absolute"); + +static SCM +fport_canonicalize_filename (SCM filename) +{ + SCM mode = scm_fluid_ref (sys_file_port_name_canonicalization); + + if (!scm_is_string (filename)) + { + return filename; + } + else if (scm_is_eq (mode, sym_relative)) + { + SCM path, rel; + + path = scm_variable_ref (scm_c_module_lookup (scm_the_root_module (), + "%load-path")); + rel = scm_i_relativize_path (filename, path); + + return scm_is_true (rel) ? rel : filename; + } + else if (scm_is_eq (mode, sym_absolute)) + { + char *str, *canon; + + str = scm_to_locale_string (filename); + canon = canonicalize_file_name (str); + free (str); + + return canon ? scm_take_locale_string (canon) : filename; + } + else + { + return filename; + } +} + +/* scm_open_file_with_encoding + Return a new port open on a given file. + + The mode string must match the pattern: [rwa+]** which + is interpreted in the usual unix way. + + Unless binary mode is requested, the character encoding of the new + port is determined as follows: First, if GUESS_ENCODING is true, + 'file-encoding' is used to guess the encoding of the file. If + GUESS_ENCODING is false or if 'file-encoding' fails, ENCODING is used + unless it is also false. As a last resort, the default port encoding + is used. It is an error to pass a non-false GUESS_ENCODING or + ENCODING if binary mode is requested. + + Return the new port. */ +SCM +scm_open_file_with_encoding (SCM filename, SCM mode, + SCM guess_encoding, SCM encoding) +#define FUNC_NAME "open-file" { SCM port; - int fdes; - int flags = 0; - char *file; - char *md; - char *ptr; + int fdes, flags = 0, binary = 0; + unsigned int retries; + char *file, *md, *ptr; + + if (SCM_UNLIKELY (!(scm_is_false (encoding) || scm_is_string (encoding)))) + scm_wrong_type_arg_msg (FUNC_NAME, 0, encoding, + "encoding to be string or false"); scm_dynwind_begin (0); @@ -349,6 +379,7 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR; break; case 'b': + binary = 1; #if defined (O_BINARY) flags |= O_BINARY; #endif @@ -361,16 +392,70 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, } ptr++; } - SCM_SYSCALL (fdes = open_or_open64 (file, flags, 0666)); - if (fdes == -1) + + for (retries = 0, fdes = -1; + fdes < 0 && retries < 2; + retries++) { - int en = errno; + SCM_SYSCALL (fdes = open_or_open64 (file, flags, 0666)); + if (fdes == -1) + { + int en = errno; + + if (en == EMFILE && retries == 0) + /* Run the GC in case it collects open file ports that are no + longer referenced. */ + scm_i_gc (FUNC_NAME); + else + SCM_SYSERROR_MSG ("~A: ~S", + scm_cons (scm_strerror (scm_from_int (en)), + scm_cons (filename, SCM_EOL)), en); + } + } + + /* Create a port from this file descriptor. The port's encoding is initially + %default-port-encoding. */ + port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode), + fport_canonicalize_filename (filename)); - SCM_SYSERROR_MSG ("~A: ~S", - scm_cons (scm_strerror (scm_from_int (en)), - scm_cons (filename, SCM_EOL)), en); + if (binary) + { + if (scm_is_true (encoding)) + scm_misc_error (FUNC_NAME, + "Encoding specified on a binary port", + scm_list_1 (encoding)); + if (scm_is_true (guess_encoding)) + scm_misc_error (FUNC_NAME, + "Request to guess encoding on a binary port", + SCM_EOL); + + /* Use the binary-friendly ISO-8859-1 encoding. */ + scm_i_set_port_encoding_x (port, NULL); + } + else + { + char *enc = NULL; + + if (scm_is_true (guess_encoding)) + { + if (SCM_INPUT_PORT_P (port)) + enc = scm_i_scan_for_encoding (port); + else + scm_misc_error (FUNC_NAME, + "Request to guess encoding on an output-only port", + SCM_EOL); + } + + if (!enc && scm_is_true (encoding)) + { + char *buf = scm_to_latin1_string (encoding); + enc = scm_gc_strdup (buf, "encoding"); + free (buf); + } + + if (enc) + scm_i_set_port_encoding_x (port, enc); } - port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode), filename); scm_dynwind_end (); @@ -378,49 +463,76 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, } #undef FUNC_NAME - -#ifdef __MINGW32__ -/* - * Try getting the appropiate file flags for a given file descriptor - * under Windows. This incorporates some fancy operations because Windows - * differentiates between file, pipe and socket descriptors. - */ -#ifndef O_ACCMODE -# define O_ACCMODE 0x0003 -#endif +SCM +scm_open_file (SCM filename, SCM mode) +{ + return scm_open_file_with_encoding (filename, mode, SCM_BOOL_F, SCM_BOOL_F); +} -static int getflags (int fdes) +/* We can't define these using SCM_KEYWORD, because keywords have not + yet been initialized when scm_init_fports is called. */ +static SCM k_guess_encoding = SCM_UNDEFINED; +static SCM k_encoding = SCM_UNDEFINED; + +SCM_DEFINE (scm_i_open_file, "open-file", 2, 0, 1, + (SCM filename, SCM mode, SCM keyword_args), + "Open the file whose name is @var{filename}, and return a port\n" + "representing that file. The attributes of the port are\n" + "determined by the @var{mode} string. The way in which this is\n" + "interpreted is similar to C stdio. The first character must be\n" + "one of the following:\n" + "@table @samp\n" + "@item r\n" + "Open an existing file for input.\n" + "@item w\n" + "Open a file for output, creating it if it doesn't already exist\n" + "or removing its contents if it does.\n" + "@item a\n" + "Open a file for output, creating it if it doesn't already\n" + "exist. All writes to the port will go to the end of the file.\n" + "The \"append mode\" can be turned off while the port is in use\n" + "@pxref{Ports and File Descriptors, fcntl}\n" + "@end table\n" + "The following additional characters can be appended:\n" + "@table @samp\n" + "@item b\n" + "Open the underlying file in binary mode, if supported by the system.\n" + "Also, open the file using the binary-compatible character encoding\n" + "\"ISO-8859-1\", ignoring the default port encoding.\n" + "@item +\n" + "Open the port for both input and output. E.g., @code{r+}: open\n" + "an existing file for both input and output.\n" + "@item 0\n" + "Create an \"unbuffered\" port. In this case input and output\n" + "operations are passed directly to the underlying port\n" + "implementation without additional buffering. This is likely to\n" + "slow down I/O operations. The buffering mode can be changed\n" + "while a port is in use @pxref{Ports and File Descriptors,\n" + "setvbuf}\n" + "@item l\n" + "Add line-buffering to the port. The port output buffer will be\n" + "automatically flushed whenever a newline character is written.\n" + "@end table\n" + "In theory we could create read/write ports which were buffered\n" + "in one direction only. However this isn't included in the\n" + "current interfaces. If a file cannot be opened with the access\n" + "requested, @code{open-file} throws an exception.") +#define FUNC_NAME s_scm_i_open_file { - int flags = 0; - struct stat buf; - int error, optlen = sizeof (int); - - /* Is this a socket ? */ - if (getsockopt (fdes, SOL_SOCKET, SO_ERROR, (void *) &error, &optlen) >= 0) - flags = O_RDWR; - /* Maybe a regular file ? */ - else if (fstat (fdes, &buf) < 0) - flags = -1; - else - { - /* Or an anonymous pipe handle ? */ - if (buf.st_mode & _S_IFIFO) - flags = PeekNamedPipe ((HANDLE) _get_osfhandle (fdes), NULL, 0, - NULL, NULL, NULL) ? O_RDONLY : O_WRONLY; - /* stdin ? */ - else if (fdes == fileno (stdin) && isatty (fdes)) - flags = O_RDONLY; - /* stdout / stderr ? */ - else if ((fdes == fileno (stdout) || fdes == fileno (stderr)) && - isatty (fdes)) - flags = O_WRONLY; - else - flags = buf.st_mode; - } - return flags; + SCM encoding = SCM_BOOL_F; + SCM guess_encoding = SCM_BOOL_F; + + scm_c_bind_keyword_arguments (FUNC_NAME, keyword_args, 0, + k_guess_encoding, &guess_encoding, + k_encoding, &encoding, + SCM_UNDEFINED); + + return scm_open_file_with_encoding (filename, mode, + guess_encoding, encoding); } -#endif /* __MINGW32__ */ +#undef FUNC_NAME + /* Building Guile ports from a file descriptor. */ /* Build a Scheme port from an open file descriptor `fdes'. @@ -434,14 +546,11 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) { SCM port; scm_t_port *pt; - int flags; + scm_t_port_internal *pti; - /* test that fdes is valid. */ -#ifdef __MINGW32__ - flags = getflags (fdes); -#else - flags = fcntl (fdes, F_GETFL, 0); -#endif + /* Test that fdes is valid. */ +#ifdef F_GETFL + int flags = fcntl (fdes, F_GETFL, 0); if (flags == -1) SCM_SYSERROR; flags &= O_ACCMODE; @@ -451,12 +560,24 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) { SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL); } +#else + /* If we don't have F_GETFL, as on mingw, at least we can test that + it is a valid file descriptor. */ + struct stat st; + if (fstat (fdes, &st) != 0) + SCM_SYSERROR; +#endif scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); port = scm_new_port_table_entry (scm_tc16_fport); SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits); - pt = SCM_PTAB_ENTRY(port); + pt = SCM_PTAB_ENTRY (port); + + /* File ports support 'setvbuf'. */ + pti = SCM_PORT_GET_INTERNAL (port); + pti->setvbuf = scm_fport_buffer_add; + { scm_t_fport *fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport), @@ -486,41 +607,14 @@ scm_fdes_to_port (int fdes, char *mode, SCM name) static int fport_input_waiting (SCM port) { -#ifdef HAVE_SELECT int fdes = SCM_FSTREAM (port)->fdes; - struct timeval timeout; - SELECT_TYPE read_set; - SELECT_TYPE write_set; - SELECT_TYPE except_set; - - FD_ZERO (&read_set); - FD_ZERO (&write_set); - FD_ZERO (&except_set); - FD_SET (fdes, &read_set); - - timeout.tv_sec = 0; - timeout.tv_usec = 0; + struct pollfd pollfd = { fdes, POLLIN, 0 }; - if (select (SELECT_SET_SIZE, - &read_set, &write_set, &except_set, &timeout) - < 0) + if (poll (&pollfd, 1, 0) < 0) scm_syserror ("fport_input_waiting"); - return FD_ISSET (fdes, &read_set) ? 1 : 0; -#elif HAVE_IOCTL && defined (FIONREAD) - /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD - (for use with winsock ioctlsocket()) but not ioctl(). */ - int fdes = SCM_FSTREAM (port)->fdes; - int remir; - ioctl(fdes, FIONREAD, &remir); - return remir; - -#else - scm_misc_error ("fport_input_waiting", - "Not fully implemented on this platform", - SCM_EOL); -#endif + return pollfd.revents & POLLIN ? 1 : 0; } @@ -539,8 +633,8 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); scm_putc (' ', port); fdes = (SCM_FSTREAM (exp))->fdes; - -#ifdef HAVE_TTYNAME + +#if (defined HAVE_TTYNAME) && (defined HAVE_POSIX) if (isatty (fdes)) scm_display (scm_ttyname (exp), port); else @@ -557,52 +651,22 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) return 1; } -#ifndef __MINGW32__ -/* thread-local block for input on fport's fdes. */ -static void -fport_wait_for_input (SCM port) -{ - int fdes = SCM_FSTREAM (port)->fdes; - - if (!fport_input_waiting (port)) - { - int n; - SELECT_TYPE readfds; - int flags = fcntl (fdes, F_GETFL); - - if (flags == -1) - scm_syserror ("scm_fdes_wait_for_input"); - if (!(flags & O_NONBLOCK)) - do - { - FD_ZERO (&readfds); - FD_SET (fdes, &readfds); - n = scm_std_select (fdes + 1, &readfds, NULL, NULL, NULL); - } - while (n == -1 && errno == EINTR); - } -} -#endif /* !__MINGW32__ */ - 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 int +static scm_t_wchar fport_fill_input (SCM port) { long count; scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_fport *fp = SCM_FSTREAM (port); -#ifndef __MINGW32__ - fport_wait_for_input (port); -#endif /* !__MINGW32__ */ SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size)); if (count == -1) scm_syserror ("fport_fill_input"); if (count == 0) - return EOF; + return (scm_t_wchar) EOF; else { pt->read_pos = pt->read_buf; @@ -611,8 +675,8 @@ fport_fill_input (SCM port) } } -static off_t_or_off64_t -fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence) +static scm_t_off +fport_seek (SCM port, scm_t_off offset, int whence) { scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_fport *fp = SCM_FSTREAM (port); @@ -663,41 +727,8 @@ fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence) return result; } -/* If we've got largefile and off_t isn't already off64_t then - fport_seek_or_seek64 needs a range checking wrapper to be fport_seek in - the port descriptor. - - Otherwise if no largefile, or off_t is the same as off64_t (which is the - case on NetBSD apparently), then fport_seek_or_seek64 is right to be - fport_seek already. */ - -#if HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T -static off_t -fport_seek (SCM port, off_t offset, int whence) -{ - off64_t rv = fport_seek_or_seek64 (port, (off64_t) offset, whence); - if (rv > OFF_T_MAX || rv < OFF_T_MIN) - { - errno = EOVERFLOW; - scm_syserror ("fport_seek"); - } - return (off_t) rv; - -} -#else -#define fport_seek fport_seek_or_seek64 -#endif - -/* `how' has been validated and is one of SEEK_SET, SEEK_CUR or SEEK_END */ -SCM -scm_i_fport_seek (SCM port, SCM offset, int how) -{ - return scm_from_off_t_or_off64_t - (fport_seek_or_seek64 (port, scm_to_off_t_or_off64_t (offset), how)); -} - static void -fport_truncate (SCM port, off_t length) +fport_truncate (SCM port, scm_t_off length) { scm_t_fport *fp = SCM_FSTREAM (port); @@ -705,36 +736,9 @@ fport_truncate (SCM port, off_t length) scm_syserror ("ftruncate"); } -int -scm_i_fport_truncate (SCM port, SCM length) -{ - scm_t_fport *fp = SCM_FSTREAM (port); - return ftruncate_or_ftruncate64 (fp->fdes, scm_to_off_t_or_off64_t (length)); -} - -/* helper for fport_write: try to write data, using multiple system - calls if required. */ -#define FUNC_NAME "write_all" -static void write_all (SCM port, const void *data, size_t remaining) -{ - int fdes = SCM_FSTREAM (port)->fdes; - - while (remaining > 0) - { - size_t done; - - SCM_SYSCALL (done = write (fdes, data, remaining)); - - if (done == -1) - SCM_SYSERROR; - remaining -= done; - data = ((const char *) data) + done; - } -} -#undef FUNC_NAME - 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); @@ -742,14 +746,16 @@ fport_write (SCM port, const void *data, size_t size) 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. */ - write_all (port, data, 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; } { - off_t space = pt->write_end - pt->write_pos; + scm_t_off space = pt->write_end - pt->write_pos; if (size <= space) { @@ -774,7 +780,9 @@ fport_write (SCM port, const void *data, size_t size) if (size >= pt->write_buf_size) { - write_all (port, ptr, remaining); + if (full_write (SCM_FPORT_FDES (port), ptr, remaining) + < remaining) + SCM_SYSERROR; return; } else @@ -790,64 +798,20 @@ fport_write (SCM port, const void *data, size_t size) fport_flush (port); } } - -/* becomes 1 when process is exiting: normal exception handling won't - work by this time. */ -extern int scm_i_terminating; +#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); - unsigned char *ptr = pt->write_buf; - long init_size = pt->write_pos - pt->write_buf; - long remaining = init_size; - - while (remaining > 0) - { - long count; + size_t count = pt->write_pos - pt->write_buf; - SCM_SYSCALL (count = write (fp->fdes, ptr, remaining)); - if (count < 0) - { - /* error. assume nothing was written this call, but - fix up the buffer for any previous successful writes. */ - long done = init_size - remaining; - - if (done > 0) - { - int i; - - for (i = 0; i < remaining; i++) - { - *(pt->write_buf + i) = *(pt->write_buf + done + i); - } - pt->write_pos = pt->write_buf + remaining; - } - if (scm_i_terminating) - { - const char *msg = "Error: could not flush file-descriptor "; - char buf[11]; - - write (2, msg, strlen (msg)); - sprintf (buf, "%d\n", fp->fdes); - write (2, buf, strlen (buf)); + written = full_write (fp->fdes, pt->write_buf, count); + if (written < count) + scm_syserror ("scm_flush"); - count = remaining; - } - else if (scm_gc_running_p) - { - /* silently ignore the error. scm_error would abort if we - called it now. */ - count = remaining; - } - else - scm_syserror ("fport_flush"); - } - ptr += count; - remaining -= count; - } pt->write_pos = pt->write_buf; pt->rw_active = SCM_PORT_NEITHER; } @@ -924,6 +888,15 @@ scm_make_fptob () return tc; } +/* We can't initialize the keywords from 'scm_init_fports', because + keywords haven't yet been initialized at that point. */ +void +scm_init_fports_keywords () +{ + k_guess_encoding = scm_from_latin1_keyword ("guess-encoding"); + k_encoding = scm_from_latin1_keyword ("encoding"); +} + void scm_init_fports () { @@ -933,6 +906,10 @@ scm_init_fports () scm_c_define ("_IOLBF", scm_from_int (_IOLBF)); scm_c_define ("_IONBF", scm_from_int (_IONBF)); + sys_file_port_name_canonicalization = scm_make_fluid (); + scm_c_define ("%file-port-name-canonicalization", + sys_file_port_name_canonicalization); + #include "libguile/fports.x" }