-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ * 2004, 2006, 2007, 2008, 2009, 2010, 2011 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
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
#include <sys/stat.h>
#endif
-
+#ifdef HAVE_POLL_H
+#include <poll.h>
+#endif
#include <errno.h>
#include <sys/types.h>
+#include <full-write.h>
+
#include "libguile/iselect.h"
/* Some defines for Windows (native port, not Cygwin). */
{
int cmode;
long csize;
+ SCM drained;
scm_t_port *pt;
port = SCM_COERCE_OUTPORT (port);
pt = SCM_PTAB_ENTRY (port);
- /* silently discards buffered and put-back chars. */
+ if (SCM_INPUT_PORT_P (port))
+ drained = scm_drain_input (port);
+ else
+ drained = scm_nullstr;
+
+ if (SCM_OUTPUT_PORT_P (port))
+ scm_flush_unlocked (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 (scm_is_true (drained) && scm_c_string_length (drained))
+ scm_unread_string (drained, port);
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
}
else if (scm_is_eq (mode, sym_relative))
{
- char *str, *canon;
- SCM scanon, load_path;
-
- str = scm_to_locale_string (filename);
- canon = canonicalize_file_name (str);
- free (str);
-
- if (!canon)
- return filename;
-
- scanon = scm_take_locale_string (canon);
-
- for (load_path = scm_variable_ref
- (scm_c_module_lookup (scm_the_root_module (), "%load-path"));
- scm_is_pair (load_path);
- load_path = scm_cdr (load_path))
- if (scm_is_true (scm_string_prefix_p (scm_car (load_path),
- scanon,
- SCM_UNDEFINED, SCM_UNDEFINED,
- SCM_UNDEFINED, SCM_UNDEFINED)))
- return scm_substring (scanon,
- scm_string_length (scm_car (load_path)),
- SCM_UNDEFINED);
- return filename;
+ 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))
{
* Return the new port.
*/
SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
- (SCM filename, SCM mode),
+ (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"
"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. "
+ "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 port's encoding and the coding declaration\n"
+ "at the top of the input file, if any.\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"
"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"
+ "When the file is opened, this procedure will scan for a coding\n"
+ "declaration@pxref{Character Encoding of Source Files}. If present\n"
+ "will use that encoding for interpreting the file. Otherwise, the\n"
+ "port's encoding will be used.\n"
+ "\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"
#define FUNC_NAME s_scm_open_file
{
SCM port;
- int fdes, flags = 0;
+ int fdes, flags = 0, use_encoding = 1;
unsigned int retries;
char *file, *md, *ptr;
flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR;
break;
case 'b':
+ use_encoding = 0;
#if defined (O_BINARY)
flags |= O_BINARY;
#endif
}
}
+ /* 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 (use_encoding)
+ {
+ /* If this file has a coding declaration, use that as the port
+ encoding. */
+ if (SCM_INPUT_PORT_P (port))
+ {
+ char *enc = scm_i_scan_for_encoding (port);
+ if (enc != NULL)
+ scm_i_set_port_encoding_x (port, enc);
+ }
+ }
+ else
+ /* If this is a binary file, use the binary-friendly ISO-8859-1
+ encoding. */
+ scm_i_set_port_encoding_x (port, NULL);
+
scm_dynwind_end ();
return port;
#define FUNC_NAME "scm_fdes_to_port"
{
SCM port;
- scm_t_port *pt;
+ scm_t_fport *fp;
int flags;
/* test that fdes is valid. */
SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
}
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+ fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
+ "file port");
+ fp->fdes = fdes;
+
+ 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);
- 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_pointerless (sizeof (scm_t_fport),
- "file port");
-
- fp->fdes = fdes;
- pt->rw_random = SCM_FDES_RANDOM_P (fdes);
- SCM_SETSTREAM (port, fp);
- 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);
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+
return port;
}
#undef FUNC_NAME
static int
fport_input_waiting (SCM port)
{
-#ifdef HAVE_SELECT
int fdes = SCM_FSTREAM (port)->fdes;
+
+ /* `FD_SETSIZE', which is 1024 on GNU systems, effectively limits the
+ highest numerical value of file descriptors that can be monitored.
+ Thus, use poll(2) whenever that is possible. */
+
+#ifdef HAVE_POLL
+ struct pollfd pollfd = { fdes, POLLIN, 0 };
+
+ if (poll (&pollfd, 1, 0) < 0)
+ scm_syserror ("fport_input_waiting");
+
+ return pollfd.revents & POLLIN ? 1 : 0;
+
+#elif defined(HAVE_SELECT)
struct timeval timeout;
SELECT_TYPE read_set;
SELECT_TYPE write_set;
static int
fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- scm_puts ("#<", port);
+ scm_puts_unlocked ("#<", port);
scm_print_port_mode (exp, port);
if (SCM_OPFPORTP (exp))
{
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);
+ scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
+ scm_putc_unlocked (' ', 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
}
else
{
- scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
- scm_putc (' ', port);
+ scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
+ scm_putc_unlocked (' ', port);
scm_uintprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port);
}
- scm_putc ('>', port);
+ scm_putc_unlocked ('>', 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_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
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 (offset != 0 || whence != SEEK_CUR)
{
/* could expand to avoid a second seek. */
- scm_end_input (port);
+ scm_end_input_unlocked (port);
result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
}
else
}
#undef FUNC_NAME
-/* becomes 1 when process is exiting: normal exception handling won't
- work by this time. */
-extern int scm_i_terminating;
-
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;
- full_write (2, msg, strlen (msg));
- sprintf (buf, "%d\n", fp->fdes);
- full_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;
}