-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
*/
\f
-#if HAVE_CONFIG_H
+#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
+#define _GNU_SOURCE /* ask for LONG_LONG_MAX/LONG_LONG_MIN */
+
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <stdio.h>
#include <fcntl.h>
-#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 <string.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#else
-size_t fwrite ();
#endif
#ifdef HAVE_IO_H
#include <io.h>
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
#include <sys/stat.h>
#endif
-
+#include <poll.h>
#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/select.h>
-#include "libguile/iselect.h"
+#include <full-write.h>
-/* Some defines for Windows (native port, not Cygwin). */
-#ifdef __MINGW32__
-# include <sys/stat.h>
-# include <winsock2.h>
-# define ftruncate(fd, size) chsize (fd, size)
-#endif /* __MINGW32__ */
+#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"
+#include "libguile/fports.h"
+
+#if SIZEOF_OFF_T == SIZEOF_INT
+#define OFF_T_MAX INT_MAX
+#define OFF_T_MIN INT_MIN
+#elif SIZEOF_OFF_T == SIZEOF_LONG
+#define OFF_T_MAX LONG_MAX
+#define OFF_T_MIN LONG_MIN
+#elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
+#define OFF_T_MAX LONG_LONG_MAX
+#define OFF_T_MIN LONG_LONG_MIN
+#else
+#error Oops, unknown OFF_T size
+#endif
scm_t_bits scm_tc16_fport;
if (SCM_INPUT_PORT_P (port) && read_size > 0)
{
- pt->read_buf = scm_gc_malloc (read_size, "port buffer");
+ 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;
}
if (SCM_OUTPUT_PORT_P (port) && write_size > 0)
{
- pt->write_buf = scm_gc_malloc (write_size, "port buffer");
+ pt->write_buf = scm_gc_malloc_pointerless (write_size, "port buffer");
pt->write_pos = pt->write_buf;
pt->write_buf_size = write_size;
}
{
int cmode;
long csize;
+ size_t ndrained;
+ char *drained;
scm_t_port *pt;
port = SCM_COERCE_OUTPORT (port);
}
else
{
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) ^ SCM_BUFLINE);
+ SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~(scm_t_bits)SCM_BUFLINE);
}
if (SCM_UNBNDP (size))
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;
scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
scm_fport_buffer_add (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
/* 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;
+ int fd = * (int*) closure;
- scm_mutex_lock (&scm_i_port_table_mutex);
-
- 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_mutex_unlock (&scm_i_port_table_mutex);
+void
+scm_evict_ports (int fd)
+{
+ scm_c_port_for_each (scm_i_evict_port, (void *) &fd);
}
#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 +\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;
- scm_frame_begin (0);
+ 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);
file = scm_to_locale_string (filename);
- scm_frame_free (file);
+ scm_dynwind_free (file);
md = scm_to_locale_string (mode);
- scm_frame_free (md);
+ scm_dynwind_free (md);
switch (*md)
{
flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR;
break;
case 'b':
+ binary = 1;
#if defined (O_BINARY)
flags |= O_BINARY;
#endif
}
ptr++;
}
- SCM_SYSCALL (fdes = open (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;
- SCM_SYSERROR_MSG ("~A: ~S",
- scm_cons (scm_strerror (scm_from_int (en)),
- scm_cons (filename, SCM_EOL)), en);
+ 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);
+ }
}
- port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode), filename);
- scm_frame_end ();
+ /* 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));
+
+ 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);
+ }
+
+ scm_dynwind_end ();
return port;
}
#undef FUNC_NAME
-\f
-#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
+\f
/* Building Guile ports from a file descriptor. */
/* Build a Scheme port from an open file descriptor `fdes'.
{
SCM port;
scm_t_port *pt;
- int flags;
- /* 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;
{
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_mutex_lock (&scm_i_port_table_mutex);
+ 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);
{
scm_t_fport *fp
- = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port");
+ = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
+ "file port");
fp->fdes = fdes;
pt->rw_random = SCM_FDES_RANDOM_P (fdes);
scm_fport_buffer_add (port, -1, -1);
}
SCM_SET_FILENAME (port, name);
- scm_mutex_unlock (&scm_i_port_table_mutex);
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return port;
}
#undef FUNC_NAME
{
int fdes = SCM_FSTREAM (port)->fdes;
-#ifdef HAVE_SELECT
- struct timeval timeout;
- SELECT_TYPE read_set;
- SELECT_TYPE write_set;
- SELECT_TYPE except_set;
+ struct pollfd pollfd = { fdes, POLLIN, 0 };
- 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;
-
- 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 defined (FIONREAD)
- 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;
}
\f
{
int fdes;
SCM name = SCM_FILENAME (exp);
- if (scm_is_string (name) || SCM_SYMBOLP (name))
+ if (scm_is_string (name) || scm_is_symbol (name))
scm_display (name, port);
else
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
{
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
scm_putc (' ', port);
- scm_intprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port);
+ scm_uintprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port);
}
scm_putc ('>', port);
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_internal_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;
}
}
-static off_t
-fport_seek (SCM port, off_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);
- off_t rv;
- off_t result;
+ off_t_or_off64_t rv;
+ off_t_or_off64_t result;
if (pt->rw_active == SCM_PORT_WRITE)
{
if (offset != 0 || whence != SEEK_CUR)
{
fport_flush (port);
- result = rv = lseek (fp->fdes, offset, whence);
+ result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
}
else
{
/* read current position without disturbing the buffer. */
- rv = lseek (fp->fdes, offset, whence);
+ rv = lseek_or_lseek64 (fp->fdes, offset, whence);
result = rv + (pt->write_pos - pt->write_buf);
}
}
{
/* could expand to avoid a second seek. */
scm_end_input (port);
- result = rv = lseek (fp->fdes, offset, whence);
+ result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
}
else
{
/* read current position without disturbing the buffer
(particularly the unread-char buffer). */
- rv = lseek (fp->fdes, offset, whence);
+ rv = lseek_or_lseek64 (fp->fdes, offset, whence);
result = rv - (pt->read_end - pt->read_pos);
if (pt->read_buf == pt->putback_buf)
}
else /* SCM_PORT_NEITHER */
{
- result = rv = lseek (fp->fdes, offset, whence);
+ result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
}
if (rv == -1)
}
static void
-fport_truncate (SCM port, off_t length)
+fport_truncate (SCM port, scm_t_off length)
{
scm_t_fport *fp = SCM_FSTREAM (port);
scm_syserror ("ftruncate");
}
-/* 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);
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)
{
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
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;
-
- 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];
+ size_t count = pt->write_pos - pt->write_buf;
- 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;
}
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 ()
{
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"
}