-/* Copyright (C) 2002, 2003, 2004, 2005
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught
#include <unistd.h>
#include <stdio.h>
+#include <stdarg.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <assert.h>
#include "libgfortran.h"
#include "io.h"
+#ifndef SSIZE_MAX
+#define SSIZE_MAX SHRT_MAX
+#endif
+
#ifndef PATH_MAX
#define PATH_MAX 1024
#endif
#define S_IWOTH 0
#endif
+
+/* Unix stream I/O module */
+
+#define BUFFER_SIZE 8192
+
+typedef struct
+{
+ stream st;
+
+ int fd;
+ gfc_offset buffer_offset; /* File offset of the start of the buffer */
+ gfc_offset physical_offset; /* Current physical file offset */
+ gfc_offset logical_offset; /* Current logical file offset */
+ gfc_offset dirty_offset; /* Start of modified bytes in buffer */
+ gfc_offset file_length; /* Length of the file, -1 if not seekable. */
+
+ char *buffer;
+ int len; /* Physical length of the current buffer */
+ int active; /* Length of valid bytes in the buffer */
+
+ int prot;
+ int ndirty; /* Dirty bytes starting at dirty_offset */
+
+ int special_file; /* =1 if the fd refers to a special file */
+
+ unsigned unbuffered:1;
+
+ char small_buffer[BUFFER_SIZE];
+
+}
+unix_stream;
+
+extern stream *init_error_stream (unix_stream *);
+internal_proto(init_error_stream);
+
+
/* This implementation of stream I/O is based on the paper:
*
* "Exploiting the advantages of mapped files for stream I/O",
* 'where' parameter and use the current file pointer. */
-#define BUFFER_SIZE 8192
-
-typedef struct
-{
- stream st;
-
- int fd;
- gfc_offset buffer_offset; /* File offset of the start of the buffer */
- gfc_offset physical_offset; /* Current physical file offset */
- gfc_offset logical_offset; /* Current logical file offset */
- gfc_offset dirty_offset; /* Start of modified bytes in buffer */
- gfc_offset file_length; /* Length of the file, -1 if not seekable. */
-
- char *buffer;
- int len; /* Physical length of the current buffer */
- int active; /* Length of valid bytes in the buffer */
-
- int prot;
- int ndirty; /* Dirty bytes starting at dirty_offset */
-
- int special_file; /* =1 if the fd refers to a special file */
-
- unsigned unbuffered:1;
-
- char small_buffer[BUFFER_SIZE];
-
-}
-unix_stream;
-
/*move_pos_offset()-- Move the record pointer right or left
*relative to current position */
return 0;
}
+/* If the stream corresponds to a preconnected unit, we flush the
+ corresponding C stream. This is bugware for mixed C-Fortran codes
+ where the C code doesn't flush I/O before returning. */
+void
+flush_if_preconnected (stream * s)
+{
+ int fd;
+
+ fd = ((unix_stream *) s)->fd;
+ if (fd == STDIN_FILENO)
+ fflush (stdin);
+ else if (fd == STDOUT_FILENO)
+ fflush (stdout);
+ else if (fd == STDERR_FILENO)
+ fflush (stderr);
+}
+
/* Reset a stream after reading/writing. Assumes that the buffers have
been flushed. */
size_t writelen;
if (s->ndirty == 0)
- return SUCCESS;;
-
- if (s->physical_offset != s->dirty_offset &&
+ return SUCCESS;
+
+ if (s->file_length != -1 && s->physical_offset != s->dirty_offset &&
lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
return FAILURE;
fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
{
gfc_offset m;
- size_t n;
if (where == -1)
where = s->logical_offset;
if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
return NULL;
- n = s->len - s->active;
- if (do_read (s, s->buffer + s->active, &n) != 0)
- return NULL;
+ /* do_read() hangs on read from terminals for *BSD-systems. Only
+ use read() in that case. */
+
+ if (s->special_file)
+ {
+ ssize_t n;
+
+ n = read (s->fd, s->buffer + s->active, s->len - s->active);
+ if (n < 0)
+ return NULL;
- s->physical_offset = where + n;
+ s->physical_offset = where + n;
+ s->active += n;
+ }
+ else
+ {
+ size_t n;
+
+ n = s->len - s->active;
+ if (do_read (s, s->buffer + s->active, &n) != 0)
+ return NULL;
+
+ s->physical_offset = where + n;
+ s->active += n;
+ }
- s->active += n;
if (s->active < *len)
*len = s->active; /* Bytes actually available */
s->logical_offset = where + *len;
- if (where + *len > s->file_length)
- s->file_length = where + *len;
+ /* Don't increment file_length if the file is non-seekable. */
+
+ if (s->file_length != -1 && s->logical_offset > s->file_length)
+ s->file_length = s->logical_offset;
n = s->logical_offset - s->buffer_offset;
if (n > s->active)
static try
fd_seek (unix_stream * s, gfc_offset offset)
{
+
+ if (s->file_length == -1)
+ return SUCCESS;
+
if (s->physical_offset == offset) /* Are we lucky and avoid syscall? */
{
s->logical_offset = offset;
}
s->physical_offset = s->logical_offset = offset;
+ s->active = 0;
return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
}
static try
fd_truncate (unix_stream * s)
{
+ /* Non-seekable files, like terminals and fifo's fail the lseek so just
+ return success, there is nothing to truncate. If its not a pipe there
+ is a real problem. */
if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
- return FAILURE;
+ {
+ if (errno == ESPIPE)
+ return SUCCESS;
+ else
+ return FAILURE;
+ }
- /* non-seekable files, like terminals and fifo's fail the lseek.
- Using ftruncate on a seekable special file (like /dev/null)
- is undefined, so we treat it as if the ftruncate failed.
- */
+ /* Using ftruncate on a seekable special file (like /dev/null)
+ is undefined, so we treat it as if the ftruncate succeeded. */
#ifdef HAVE_FTRUNCATE
if (s->special_file || ftruncate (s->fd, s->logical_offset))
#else
#endif
{
s->physical_offset = s->file_length = 0;
- return FAILURE;
+ return SUCCESS;
}
s->physical_offset = s->file_length = s->logical_offset;
-
+ s->active = 0;
return SUCCESS;
}
+/* Similar to memset(), but operating on a stream instead of a string.
+ Takes care of not using too much memory. */
+
+static try
+fd_sset (unix_stream * s, int c, size_t n)
+{
+ size_t bytes_left;
+ int trans;
+ void *p;
+
+ bytes_left = n;
+
+ while (bytes_left > 0)
+ {
+ /* memset() in chunks of BUFFER_SIZE. */
+ trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE;
+
+ p = fd_alloc_w_at (s, &trans, -1);
+ if (p)
+ memset (p, c, trans);
+ else
+ return FAILURE;
+
+ bytes_left -= trans;
+ }
+
+ return SUCCESS;
+}
/* Stream read function. Avoids using a buffer for big reads. The
s->st.truncate = (void *) fd_truncate;
s->st.read = (void *) fd_read;
s->st.write = (void *) fd_write;
+ s->st.set = (void *) fd_sset;
s->buffer = NULL;
}
}
+static try
+mem_set (unix_stream * s, int c, size_t n)
+{
+ void *p;
+ int len;
+
+ len = n;
+
+ p = mem_alloc_w_at (s, &len, -1);
+ if (p)
+ {
+ memset (p, c, len);
+ return SUCCESS;
+ }
+ else
+ return FAILURE;
+}
+
+
static int
mem_truncate (unix_stream * s __attribute__ ((unused)))
{
static try
mem_close (unix_stream * s)
{
- free_mem (s);
+ if (s != NULL)
+ free_mem (s);
return SUCCESS;
}
s->st.truncate = (void *) mem_truncate;
s->st.read = (void *) mem_read;
s->st.write = (void *) mem_write;
+ s->st.set = (void *) mem_set;
return (stream *) s;
}
/* Get the current length of the file. */
fstat (fd, &statbuf);
- s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
+
+ if (lseek (fd, 0, SEEK_CUR) == (off_t) -1)
+ s->file_length = -1;
+ else
+ s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
+
s->special_file = !S_ISREG (statbuf.st_mode);
fd_open (s);
/* Given the Fortran unit number, convert it to a C file descriptor. */
int
-unit_to_fd(int unit)
+unit_to_fd (int unit)
{
gfc_unit *us;
+ int fd;
- us = find_unit(unit);
+ us = find_unit (unit);
if (us == NULL)
return -1;
- return ((unix_stream *) us->s)->fd;
+ fd = ((unix_stream *) us->s)->fd;
+ unlock_unit (us);
+ return fd;
}
* open it. mkstemp() opens the file for reading and writing, but the
* library mode prevents anything that is not allowed. The descriptor
* is returned, which is -1 on error. The template is pointed to by
- * ioparm.file, which is copied into the unit structure
+ * opp->file, which is copied into the unit structure
* and freed later. */
static int
-tempfile (void)
+tempfile (st_parameter_open *opp)
{
const char *tempdir;
char *template;
if (mktemp (template))
do
-#ifdef HAVE_CRLF
+#if defined(HAVE_CRLF) && defined(O_BINARY)
fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY,
S_IREAD | S_IWRITE);
#else
free_mem (template);
else
{
- ioparm.file = template;
- ioparm.file_len = strlen (template); /* Don't include trailing nul */
+ opp->file = template;
+ opp->file_len = strlen (template); /* Don't include trailing nul */
}
return fd;
* Returns the descriptor, which is less than zero on error. */
static int
-regular_file (unit_flags *flags)
+regular_file (st_parameter_open *opp, unit_flags *flags)
{
char path[PATH_MAX + 1];
int mode;
int crflag;
int fd;
- if (unpack_filename (path, ioparm.file, ioparm.file_len))
+ if (unpack_filename (path, opp->file, opp->file_len))
{
errno = ENOENT; /* Fake an OS error */
return -1;
break;
default:
- internal_error ("regular_file(): Bad action");
+ internal_error (&opp->common, "regular_file(): Bad action");
}
switch (flags->status)
break;
default:
- internal_error ("regular_file(): Bad status");
+ internal_error (&opp->common, "regular_file(): Bad status");
}
/* rwflag |= O_LARGEFILE; */
-#ifdef HAVE_CRLF
+#if defined(HAVE_CRLF) && defined(O_BINARY)
crflag |= O_BINARY;
#endif
* Returns NULL on operating system error. */
stream *
-open_external (unit_flags *flags)
+open_external (st_parameter_open *opp, unit_flags *flags)
{
int fd, prot;
if (flags->status == STATUS_SCRATCH)
{
- fd = tempfile ();
+ fd = tempfile (opp);
if (flags->action == ACTION_UNSPECIFIED)
flags->action = ACTION_READWRITE;
#if HAVE_UNLINK_OPEN_FILE
/* We can unlink scratch files now and it will go away when closed. */
- unlink (ioparm.file);
+ if (fd >= 0)
+ unlink (opp->file);
#endif
}
else
{
/* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
* if it succeeds */
- fd = regular_file (flags);
+ fd = regular_file (opp, flags);
}
if (fd < 0)
break;
default:
- internal_error ("open_external(): Bad action");
+ internal_error (&opp->common, "open_external(): Bad action");
}
return fd_to_stream (fd, prot);
stream *
output_stream (void)
{
+#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
+ setmode (STDOUT_FILENO, O_BINARY);
+#endif
return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
}
stream *
error_stream (void)
{
+#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
+ setmode (STDERR_FILENO, O_BINARY);
+#endif
return fd_to_stream (STDERR_FILENO, PROT_WRITE);
}
* corrupted. */
stream *
-init_error_stream (void)
+init_error_stream (unix_stream *error)
+{
+ memset (error, '\0', sizeof (*error));
+
+ error->fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
+
+ error->st.alloc_w_at = (void *) fd_alloc_w_at;
+ error->st.sfree = (void *) fd_sfree;
+
+ error->unbuffered = 1;
+ error->buffer = error->small_buffer;
+
+ return (stream *) error;
+}
+
+/* st_printf()-- simple printf() function for streams that handles the
+ * formats %d, %s and %c. This function handles printing of error
+ * messages that originate within the library itself, not from a user
+ * program. */
+
+int
+st_printf (const char *format, ...)
{
- static unix_stream error;
+ int count, total;
+ va_list arg;
+ char *p;
+ const char *q;
+ stream *s;
+ char itoa_buf[GFC_ITOA_BUF_SIZE];
+ unix_stream err_stream;
+
+ total = 0;
+ s = init_error_stream (&err_stream);
+ va_start (arg, format);
+
+ for (;;)
+ {
+ count = 0;
- memset (&error, '\0', sizeof (error));
+ while (format[count] != '%' && format[count] != '\0')
+ count++;
- error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
+ if (count != 0)
+ {
+ p = salloc_w (s, &count);
+ memmove (p, format, count);
+ sfree (s);
+ }
- error.st.alloc_w_at = (void *) fd_alloc_w_at;
- error.st.sfree = (void *) fd_sfree;
+ total += count;
+ format += count;
+ if (*format++ == '\0')
+ break;
- error.unbuffered = 1;
- error.buffer = error.small_buffer;
+ switch (*format)
+ {
+ case 'c':
+ count = 1;
+
+ p = salloc_w (s, &count);
+ *p = (char) va_arg (arg, int);
+
+ sfree (s);
+ break;
+
+ case 'd':
+ q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case 'x':
+ q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf));
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case 's':
+ q = va_arg (arg, char *);
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case '\0':
+ return total;
+
+ default:
+ count = 2;
+ p = salloc_w (s, &count);
+ p[0] = format[-1];
+ p[1] = format[0];
+ sfree (s);
+ break;
+ }
+
+ total += count;
+ format++;
+ }
- return (stream *) & error;
+ va_end (arg);
+ return total;
}
* filename. */
int
-compare_file_filename (stream * s, const char *name, int len)
+compare_file_filename (gfc_unit *u, const char *name, int len)
{
char path[PATH_MAX + 1];
- struct stat st1, st2;
+ struct stat st1;
+#ifdef HAVE_WORKING_STAT
+ struct stat st2;
+#endif
if (unpack_filename (path, name, len))
return 0; /* Can't be the same */
if (stat (path, &st1) < 0)
return 0;
- fstat (((unix_stream *) s)->fd, &st2);
-
+#ifdef HAVE_WORKING_STAT
+ fstat (((unix_stream *) (u->s))->fd, &st2);
return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
+#else
+ if (len != u->file_len)
+ return 0;
+ return (memcmp(path, u->file, len) == 0);
+#endif
}
+#ifdef HAVE_WORKING_STAT
+# define FIND_FILE0_DECL struct stat *st
+# define FIND_FILE0_ARGS st
+#else
+# define FIND_FILE0_DECL const char *file, gfc_charlen_type file_len
+# define FIND_FILE0_ARGS file, file_len
+#endif
+
/* find_file0()-- Recursive work function for find_file() */
static gfc_unit *
-find_file0 (gfc_unit * u, struct stat *st1)
+find_file0 (gfc_unit *u, FIND_FILE0_DECL)
{
- struct stat st2;
gfc_unit *v;
if (u == NULL)
return NULL;
- if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
- st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
+#ifdef HAVE_WORKING_STAT
+ if (u->s != NULL
+ && fstat (((unix_stream *) u->s)->fd, &st[1]) >= 0 &&
+ st[0].st_dev == st[1].st_dev && st[0].st_ino == st[1].st_ino)
return u;
+#else
+ if (compare_string (u->file_len, u->file, file_len, file) == 0)
+ return u;
+#endif
- v = find_file0 (u->left, st1);
+ v = find_file0 (u->left, FIND_FILE0_ARGS);
if (v != NULL)
return v;
- v = find_file0 (u->right, st1);
+ v = find_file0 (u->right, FIND_FILE0_ARGS);
if (v != NULL)
return v;
* that has the file already open. Returns a pointer to the unit if so. */
gfc_unit *
-find_file (void)
+find_file (const char *file, gfc_charlen_type file_len)
{
char path[PATH_MAX + 1];
- struct stat statbuf;
+ struct stat st[2];
+ gfc_unit *u;
- if (unpack_filename (path, ioparm.file, ioparm.file_len))
+ if (unpack_filename (path, file, file_len))
return NULL;
- if (stat (path, &statbuf) < 0)
+ if (stat (path, &st[0]) < 0)
return NULL;
- return find_file0 (g.unit_root, &statbuf);
+ __gthread_mutex_lock (&unit_lock);
+retry:
+ u = find_file0 (unit_root, FIND_FILE0_ARGS);
+ if (u != NULL)
+ {
+ /* Fast path. */
+ if (! __gthread_mutex_trylock (&u->lock))
+ {
+ /* assert (u->closed == 0); */
+ __gthread_mutex_unlock (&unit_lock);
+ return u;
+ }
+
+ inc_waiting_locked (u);
+ }
+ __gthread_mutex_unlock (&unit_lock);
+ if (u != NULL)
+ {
+ __gthread_mutex_lock (&u->lock);
+ if (u->closed)
+ {
+ __gthread_mutex_lock (&unit_lock);
+ __gthread_mutex_unlock (&u->lock);
+ if (predec_waiting_locked (u) == 0)
+ free_mem (u);
+ goto retry;
+ }
+
+ dec_waiting_unlocked (u);
+ }
+ return u;
+}
+
+static gfc_unit *
+flush_all_units_1 (gfc_unit *u, int min_unit)
+{
+ while (u != NULL)
+ {
+ if (u->unit_number > min_unit)
+ {
+ gfc_unit *r = flush_all_units_1 (u->left, min_unit);
+ if (r != NULL)
+ return r;
+ }
+ if (u->unit_number >= min_unit)
+ {
+ if (__gthread_mutex_trylock (&u->lock))
+ return u;
+ if (u->s)
+ flush (u->s);
+ __gthread_mutex_unlock (&u->lock);
+ }
+ u = u->right;
+ }
+ return NULL;
+}
+
+void
+flush_all_units (void)
+{
+ gfc_unit *u;
+ int min_unit = 0;
+
+ __gthread_mutex_lock (&unit_lock);
+ do
+ {
+ u = flush_all_units_1 (unit_root, min_unit);
+ if (u != NULL)
+ inc_waiting_locked (u);
+ __gthread_mutex_unlock (&unit_lock);
+ if (u == NULL)
+ return;
+
+ __gthread_mutex_lock (&u->lock);
+
+ min_unit = u->unit_number + 1;
+
+ if (u->closed == 0)
+ {
+ flush (u->s);
+ __gthread_mutex_lock (&unit_lock);
+ __gthread_mutex_unlock (&u->lock);
+ (void) predec_waiting_locked (u);
+ }
+ else
+ {
+ __gthread_mutex_lock (&unit_lock);
+ __gthread_mutex_unlock (&u->lock);
+ if (predec_waiting_locked (u) == 0)
+ free_mem (u);
+ }
+ }
+ while (1);
}
}
-/* stream_at_eof()-- Returns nonzero if the stream is at the beginning
+/* stream_at_eof()-- Returns nonzero if the stream is at the end
* of the file. */
int
* the system */
int
-file_exists (void)
+file_exists (const char *file, gfc_charlen_type file_len)
{
char path[PATH_MAX + 1];
struct stat statbuf;
- if (unpack_filename (path, ioparm.file, ioparm.file_len))
+ if (unpack_filename (path, file, file_len))
return 0;
if (stat (path, &statbuf) < 0)
#endif
}
+gfc_offset
+stream_offset (stream *s)
+{
+ return (((unix_stream *) s)->logical_offset);
+}
+
/* How files are stored: This is an operating-system specific issue,
and therefore belongs here. There are three cases to consider.
OSDN Git Service
