-/* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
the Free Software Foundation; either version 2, or (at your option)
any later version.
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
Libgfortran 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
You should have received a copy of the GNU General Public License
along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
/* Unix stream I/O module */
-#include "config.h"
+#include "io.h"
#include <stdlib.h>
#include <limits.h>
#include <unistd.h>
#include <sys/stat.h>
#include <fcntl.h>
+#include <assert.h>
-#include <sys/mman.h>
#include <string.h>
#include <errno.h>
-#include "libgfortran.h"
-#include "io.h"
+#ifndef SSIZE_MAX
+#define SSIZE_MAX SHRT_MAX
+#endif
#ifndef PATH_MAX
#define PATH_MAX 1024
#endif
-#ifndef MAP_FAILED
-#define MAP_FAILED ((void *) -1)
+#ifndef PROT_READ
+#define PROT_READ 1
+#endif
+
+#ifndef PROT_WRITE
+#define PROT_WRITE 2
+#endif
+
+/* These flags aren't defined on all targets (mingw32), so provide them
+ here. */
+#ifndef S_IRGRP
+#define S_IRGRP 0
+#endif
+
+#ifndef S_IWGRP
+#define S_IWGRP 0
#endif
+#ifndef S_IROTH
+#define S_IROTH 0
+#endif
+
+#ifndef S_IWOTH
+#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. */
+
+ 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 */
+
+ int unbuffered; /* =1 if the stream is not buffered */
+
+ char *buffer;
+ char small_buffer[BUFFER_SIZE];
+}
+unix_stream;
+
+
+/* Stream structure for internal files. Fields must be kept in sync
+ with unix_stream above, except for the buffer. For internal files
+ we point the buffer pointer directly at the destination memory. */
+
+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. */
+
+ 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 */
+
+ int unbuffered; /* =1 if the stream is not buffered */
+
+ char *buffer;
+}
+int_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 */
-
- unsigned unbuffered:1, mmaped:1;
-
- char small_buffer[BUFFER_SIZE];
-
-}
-unix_stream;
-
/*move_pos_offset()-- Move the record pointer right or left
*relative to current position */
unix_stream * str = (unix_stream*)st;
if (pos_off < 0)
{
- str->active += pos_off;
- if (str->active < 0)
- str->active = 0;
-
- str->logical_offset += pos_off;
+ str->logical_offset += pos_off;
- if (str->dirty_offset+str->ndirty > str->logical_offset)
+ if (str->dirty_offset + str->ndirty > str->logical_offset)
{
- if (str->ndirty + pos_off > 0)
- str->ndirty += pos_off ;
+ if (str->ndirty + pos_off > 0)
+ str->ndirty += pos_off;
else
{
str->dirty_offset += pos_off + pos_off;
- str->ndirty = 0 ;
+ str->ndirty = 0;
}
}
- return pos_off ;
+ return pos_off;
}
- return 0 ;
+ return 0;
}
static int
fix_fd (int fd)
{
+#ifdef HAVE_DUP
int input, output, error;
input = output = error = 0;
-/* Unix allocates the lowest descriptors first, so a loop is not
- * required, but this order is. */
-
+ /* Unix allocates the lowest descriptors first, so a loop is not
+ required, but this order is. */
if (fd == STDIN_FILENO)
{
fd = dup (fd);
close (STDOUT_FILENO);
if (error)
close (STDERR_FILENO);
+#endif
return fd;
}
+int
+is_preconnected (stream * s)
+{
+ int fd;
-/* write()-- Write a buffer to a descriptor, allowing for short writes */
+ fd = ((unix_stream *) s)->fd;
+ if (fd == STDIN_FILENO || fd == STDOUT_FILENO || fd == STDERR_FILENO)
+ return 1;
+ else
+ return 0;
+}
-static int
-writen (int fd, char *buffer, int len)
+/* 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 n, n0;
+ int fd;
- n0 = len;
+ 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);
+}
- while (len > 0)
- {
- n = write (fd, buffer, len);
- if (n < 0)
- return n;
- buffer += n;
- len -= n;
- }
+/* Reset a stream after reading/writing. Assumes that the buffers have
+ been flushed. */
- return n0;
+inline static void
+reset_stream (unix_stream * s, size_t bytes_rw)
+{
+ s->physical_offset += bytes_rw;
+ s->logical_offset = s->physical_offset;
+ if (s->file_length != -1 && s->physical_offset > s->file_length)
+ s->file_length = s->physical_offset;
}
-#if 0
-/* readn()-- Read bytes into a buffer, allowing for short reads. If
- * fewer than len bytes are returned, it is because we've hit the end
- * of file. */
+/* Read bytes into a buffer, allowing for short reads. If the nbytes
+ * argument is less on return than on entry, it is because we've hit
+ * the end of file. */
static int
-readn (int fd, char *buffer, int len)
+do_read (unix_stream * s, void * buf, size_t * nbytes)
{
- int nread, n;
+ ssize_t trans;
+ size_t bytes_left;
+ char *buf_st;
+ int status;
+
+ status = 0;
+ bytes_left = *nbytes;
+ buf_st = (char *) buf;
+
+ /* We must read in a loop since some systems don't restart system
+ calls in case of a signal. */
+ while (bytes_left > 0)
+ {
+ /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
+ so we must read in chunks smaller than SSIZE_MAX. */
+ trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
+ trans = read (s->fd, buf_st, trans);
+ if (trans < 0)
+ {
+ if (errno == EINTR)
+ continue;
+ else
+ {
+ status = errno;
+ break;
+ }
+ }
+ else if (trans == 0) /* We hit EOF. */
+ break;
+ buf_st += trans;
+ bytes_left -= trans;
+ }
- nread = 0;
+ *nbytes -= bytes_left;
+ return status;
+}
- while (len > 0)
- {
- n = read (fd, buffer, len);
- if (n < 0)
- return n;
- if (n == 0)
- return nread;
+/* Write a buffer to a stream, allowing for short writes. */
- buffer += n;
- nread += n;
- len -= n;
+static int
+do_write (unix_stream * s, const void * buf, size_t * nbytes)
+{
+ ssize_t trans;
+ size_t bytes_left;
+ char *buf_st;
+ int status;
+
+ status = 0;
+ bytes_left = *nbytes;
+ buf_st = (char *) buf;
+
+ /* We must write in a loop since some systems don't restart system
+ calls in case of a signal. */
+ while (bytes_left > 0)
+ {
+ /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
+ so we must write in chunks smaller than SSIZE_MAX. */
+ trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
+ trans = write (s->fd, buf_st, trans);
+ if (trans < 0)
+ {
+ if (errno == EINTR)
+ continue;
+ else
+ {
+ status = errno;
+ break;
+ }
+ }
+ buf_st += trans;
+ bytes_left -= trans;
}
- return nread;
+ *nbytes -= bytes_left;
+ return status;
}
-#endif
/* get_oserror()-- Get the most recent operating system error. For
const char *
get_oserror (void)
{
-
return strerror (errno);
}
-/* sys_exit()-- Terminate the program with an exit code */
-
-void
-sys_exit (int code)
-{
-
- exit (code);
-}
-
-
-
/*********************************************************************
File descriptor stream functions
*********************************************************************/
+
/* fd_flush()-- Write bytes that need to be written */
static try
fd_flush (unix_stream * s)
{
+ 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;
- if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
- s->ndirty) < 0)
+ writelen = s->ndirty;
+ if (do_write (s, s->buffer + (s->dirty_offset - s->buffer_offset),
+ &writelen) != 0)
return FAILURE;
- s->physical_offset = s->dirty_offset + s->ndirty;
+ s->physical_offset = s->dirty_offset + writelen;
/* don't increment file_length if the file is non-seekable */
if (s->file_length != -1 && s->physical_offset > s->file_length)
- s->file_length = s->physical_offset;
- s->ndirty = 0;
+ s->file_length = s->physical_offset;
+
+ s->ndirty -= writelen;
+ if (s->ndirty != 0)
+ return FAILURE;
return SUCCESS;
}
* to come next. */
static void
-fd_alloc (unix_stream * s, gfc_offset where, int *len)
+fd_alloc (unix_stream * s, gfc_offset where,
+ int *len __attribute__ ((unused)))
{
char *new_buffer;
int n, read_len;
s->buffer = new_buffer;
s->len = read_len;
- s->mmaped = 0;
}
fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
{
gfc_offset m;
- int n;
if (where == -1)
where = s->logical_offset;
if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
return NULL;
- n = read (s->fd, s->buffer + s->active, s->len - s->active);
- if (n < 0)
- return NULL;
+ /* do_read() hangs on read from terminals for *BSD-systems. Only
+ use read() in that case. */
- s->physical_offset = where + n;
+ 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 = m + 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 = m + n;
+ s->active += n;
+ }
- s->active += n;
if (s->active < *len)
*len = s->active; /* Bytes actually available */
s->ndirty = where + *len - start;
else
s->ndirty = s->dirty_offset + s->ndirty - start;
- s->dirty_offset = start;
+ s->dirty_offset = start;
}
s->logical_offset = 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)
s->active = n;
static try
fd_sfree (unix_stream * s)
{
-
if (s->ndirty != 0 &&
(s->buffer != s->small_buffer || options.all_unbuffered ||
s->unbuffered))
}
-static int
+static try
fd_seek (unix_stream * s, gfc_offset offset)
{
- s->physical_offset = s->logical_offset = offset;
+ if (s->file_length == -1)
+ return SUCCESS;
- return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
+ if (s->physical_offset == offset) /* Are we lucky and avoid syscall? */
+ {
+ s->logical_offset = offset;
+ return SUCCESS;
+ }
+
+ if (lseek (s->fd, offset, SEEK_SET) >= 0)
+ {
+ s->physical_offset = s->logical_offset = offset;
+ s->active = 0;
+ return SUCCESS;
+ }
+
+ return FAILURE;
}
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;
-
- /* non-seekable files, like terminals and fifo's fail the lseek.
- the fd is a regular file at this point */
-
- if (ftruncate (s->fd, s->logical_offset))
- {
- return FAILURE;
- }
-
- s->physical_offset = s->file_length = s->logical_offset;
-
- return SUCCESS;
-}
-
-
-static try
-fd_close (unix_stream * s)
-{
-
- if (fd_flush (s) == FAILURE)
- return FAILURE;
-
- if (s->buffer != NULL && s->buffer != s->small_buffer)
- free_mem (s->buffer);
-
- if (close (s->fd) < 0)
- return FAILURE;
-
- free_mem (s);
-
- return SUCCESS;
-}
-
-
-static void
-fd_open (unix_stream * s)
-{
-
- if (isatty (s->fd))
- s->unbuffered = 1;
-
- s->st.alloc_r_at = (void *) fd_alloc_r_at;
- s->st.alloc_w_at = (void *) fd_alloc_w_at;
- s->st.sfree = (void *) fd_sfree;
- s->st.close = (void *) fd_close;
- s->st.seek = (void *) fd_seek;
- s->st.truncate = (void *) fd_truncate;
-
- s->buffer = NULL;
-}
-
-
-/*********************************************************************
- mmap stream functions
-
- Because mmap() is not capable of extending a file, we have to keep
- track of how long the file is. We also have to be able to detect end
- of file conditions. If there are multiple writers to the file (which
- can only happen outside the current program), things will get
- confused. Then again, things will get confused anyway.
-
-*********************************************************************/
-
-#if HAVE_MMAP
-
-static int page_size, page_mask;
-
-/* mmap_flush()-- Deletes a memory mapping if something is mapped. */
-
-static try
-mmap_flush (unix_stream * s)
-{
-
- if (!s->mmaped)
- return fd_flush (s);
-
- if (s->buffer == NULL)
- return SUCCESS;
-
- if (munmap (s->buffer, s->active))
- return FAILURE;
-
- s->buffer = NULL;
- s->active = 0;
-
- return SUCCESS;
-}
-
-
-/* mmap_alloc()-- mmap() a section of the file. The whole section is
- * guaranteed to be mappable. */
-
-static try
-mmap_alloc (unix_stream * s, gfc_offset where, int *len)
-{
- gfc_offset offset;
- int length;
- char *p;
-
- if (mmap_flush (s) == FAILURE)
- return FAILURE;
-
- offset = where & page_mask; /* Round down to the next page */
-
- length = ((where - offset) & page_mask) + 2 * page_size;
-
- p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
- if (p == (char *) MAP_FAILED)
- return FAILURE;
-
- s->mmaped = 1;
- s->buffer = p;
- s->buffer_offset = offset;
- s->active = length;
-
- return SUCCESS;
-}
-
-
-static char *
-mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
-{
- gfc_offset m;
-
- if (where == -1)
- where = s->logical_offset;
-
- m = where + *len;
-
- if ((s->buffer == NULL || s->buffer_offset > where ||
- m > s->buffer_offset + s->active) &&
- mmap_alloc (s, where, len) == FAILURE)
- return NULL;
-
- if (m > s->file_length)
{
- *len = s->file_length - s->logical_offset;
- s->logical_offset = s->file_length;
+ if (errno == ESPIPE)
+ return SUCCESS;
+ else
+ return FAILURE;
}
- else
- s->logical_offset = m;
-
- return s->buffer + (where - s->buffer_offset);
-}
-
-
-static char *
-mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
-{
- if (where == -1)
- where = s->logical_offset;
-
- /* If we're extending the file, we have to use file descriptor
- * methods. */
- if (where + *len > s->file_length)
+ /* 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
+#ifdef HAVE_CHSIZE
+ if (s->special_file || chsize (s->fd, s->logical_offset))
+#endif
+#endif
{
- if (s->mmaped)
- mmap_flush (s);
- return fd_alloc_w_at (s, len, where);
+ s->physical_offset = s->file_length = 0;
+ return SUCCESS;
}
- if ((s->buffer == NULL || s->buffer_offset > where ||
- where + *len > s->buffer_offset + s->active) &&
- mmap_alloc (s, where, len) == FAILURE)
- return NULL;
-
- s->logical_offset = where + *len;
-
- return s->buffer + where - s->buffer_offset;
-}
-
-
-static int
-mmap_seek (unix_stream * s, gfc_offset offset)
-{
-
- s->logical_offset = offset;
+ 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
-mmap_close (unix_stream * s)
+fd_sset (unix_stream * s, int c, size_t n)
{
- try t;
+ size_t bytes_left;
+ int trans;
+ void *p;
- t = mmap_flush (s);
+ bytes_left = n;
- if (close (s->fd) < 0)
- t = FAILURE;
- free_mem (s);
+ 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 t;
+ return SUCCESS;
}
-static try
-mmap_sfree (unix_stream * s)
+/* Stream read function. Avoids using a buffer for big reads. The
+ interface is like POSIX read(), but the nbytes argument is a
+ pointer; on return it contains the number of bytes written. The
+ function return value is the status indicator (0 for success). */
+
+static int
+fd_read (unix_stream * s, void * buf, size_t * nbytes)
{
+ void *p;
+ int tmp, status;
- return SUCCESS;
+ if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+ {
+ tmp = *nbytes;
+ p = fd_alloc_r_at (s, &tmp, -1);
+ if (p)
+ {
+ *nbytes = tmp;
+ memcpy (buf, p, *nbytes);
+ return 0;
+ }
+ else
+ {
+ *nbytes = 0;
+ return errno;
+ }
+ }
+
+ /* If the request is bigger than BUFFER_SIZE we flush the buffers
+ and read directly. */
+ if (fd_flush (s) == FAILURE)
+ {
+ *nbytes = 0;
+ return errno;
+ }
+
+ if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
+ {
+ *nbytes = 0;
+ return errno;
+ }
+
+ status = do_read (s, buf, nbytes);
+ reset_stream (s, *nbytes);
+ return status;
}
-/* mmap_open()-- mmap_specific open. If the particular file cannot be
- * mmap()-ed, we fall back to the file descriptor functions. */
+/* Stream write function. Avoids using a buffer for big writes. The
+ interface is like POSIX write(), but the nbytes argument is a
+ pointer; on return it contains the number of bytes written. The
+ function return value is the status indicator (0 for success). */
-static try
-mmap_open (unix_stream * s)
+static int
+fd_write (unix_stream * s, const void * buf, size_t * nbytes)
{
- char *p;
- int i;
+ void *p;
+ int tmp, status;
- page_size = getpagesize ();
- page_mask = ~0;
-
- p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
- if (p == (char *) MAP_FAILED)
+ if (*nbytes < BUFFER_SIZE && !s->unbuffered)
{
- fd_open (s);
- return SUCCESS;
+ tmp = *nbytes;
+ p = fd_alloc_w_at (s, &tmp, -1);
+ if (p)
+ {
+ *nbytes = tmp;
+ memcpy (p, buf, *nbytes);
+ return 0;
+ }
+ else
+ {
+ *nbytes = 0;
+ return errno;
+ }
}
- munmap (p, page_size);
+ /* If the request is bigger than BUFFER_SIZE we flush the buffers
+ and write directly. */
+ if (fd_flush (s) == FAILURE)
+ {
+ *nbytes = 0;
+ return errno;
+ }
- i = page_size >> 1;
- while (i != 0)
+ if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
{
- page_mask <<= 1;
- i >>= 1;
+ *nbytes = 0;
+ return errno;
}
- s->st.alloc_r_at = (void *) mmap_alloc_r_at;
- s->st.alloc_w_at = (void *) mmap_alloc_w_at;
- s->st.sfree = (void *) mmap_sfree;
- s->st.close = (void *) mmap_close;
- s->st.seek = (void *) mmap_seek;
- s->st.truncate = (void *) fd_truncate;
+ status = do_write (s, buf, nbytes);
+ reset_stream (s, *nbytes);
+ return status;
+}
+
- if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
+static try
+fd_close (unix_stream * s)
+{
+ if (fd_flush (s) == FAILURE)
return FAILURE;
+ if (s->buffer != NULL && s->buffer != s->small_buffer)
+ free_mem (s->buffer);
+
+ if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
+ {
+ if (close (s->fd) < 0)
+ return FAILURE;
+ }
+
+ free_mem (s);
+
return SUCCESS;
}
-#endif
+
+static void
+fd_open (unix_stream * s)
+{
+ if (isatty (s->fd))
+ s->unbuffered = 1;
+
+ s->st.alloc_r_at = (void *) fd_alloc_r_at;
+ s->st.alloc_w_at = (void *) fd_alloc_w_at;
+ s->st.sfree = (void *) fd_sfree;
+ s->st.close = (void *) fd_close;
+ s->st.seek = (void *) fd_seek;
+ s->st.trunc = (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 char *
-mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
+mem_alloc_r_at (int_stream * s, int *len, gfc_offset where)
{
gfc_offset n;
if (where < s->buffer_offset || where > s->buffer_offset + s->active)
return NULL;
- if (is_internal_unit() && where + *len > s->file_length)
- return NULL;
-
s->logical_offset = where + *len;
- n = (where - s->buffer_offset) - s->active;
+ n = s->buffer_offset + s->active - where;
if (*len > n)
*len = n;
static char *
-mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
+mem_alloc_w_at (int_stream * s, int *len, gfc_offset where)
{
gfc_offset m;
+ assert (*len >= 0); /* Negative values not allowed. */
+
if (where == -1)
where = s->logical_offset;
m = where + *len;
- if (where < s->buffer_offset || m > s->buffer_offset + s->active)
+ if (where < s->buffer_offset)
+ return NULL;
+
+ if (m > s->file_length)
return NULL;
s->logical_offset = m;
}
+/* Stream read function for internal units. This is not actually used
+ at the moment, as all internal IO is formatted and the formatted IO
+ routines use mem_alloc_r_at. */
+
+static int
+mem_read (int_stream * s, void * buf, size_t * nbytes)
+{
+ void *p;
+ int tmp;
+
+ tmp = *nbytes;
+ p = mem_alloc_r_at (s, &tmp, -1);
+ if (p)
+ {
+ *nbytes = tmp;
+ memcpy (buf, p, *nbytes);
+ return 0;
+ }
+ else
+ {
+ *nbytes = 0;
+ return errno;
+ }
+}
+
+
+/* Stream write function for internal units. This is not actually used
+ at the moment, as all internal IO is formatted and the formatted IO
+ routines use mem_alloc_w_at. */
+
static int
-mem_seek (unix_stream * s, gfc_offset offset)
+mem_write (int_stream * s, const void * buf, size_t * nbytes)
{
+ void *p;
+ int tmp;
+
+ errno = 0;
+
+ tmp = *nbytes;
+ p = mem_alloc_w_at (s, &tmp, -1);
+ if (p)
+ {
+ *nbytes = tmp;
+ memcpy (p, buf, *nbytes);
+ return 0;
+ }
+ else
+ {
+ *nbytes = 0;
+ return errno;
+ }
+}
+
+static int
+mem_seek (int_stream * s, gfc_offset offset)
+{
if (offset > s->file_length)
{
errno = ESPIPE;
}
-static int
-mem_truncate (unix_stream * s)
+static try
+mem_set (int_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 (int_stream * s __attribute__ ((unused)))
+{
return SUCCESS;
}
static try
-mem_close (unix_stream * s)
+mem_close (int_stream * s)
{
+ if (s != NULL)
+ free_mem (s);
return SUCCESS;
}
static try
-mem_sfree (unix_stream * s)
+mem_sfree (int_stream * s __attribute__ ((unused)))
{
-
return SUCCESS;
}
void
empty_internal_buffer(stream *strm)
{
- unix_stream * s = (unix_stream *) strm;
- memset(s->buffer, ' ', s->file_length);
+ int_stream * s = (int_stream *) strm;
+ memset(s->buffer, ' ', s->file_length);
}
/* open_internal()-- Returns a stream structure from an internal file */
stream *
open_internal (char *base, int length)
{
- unix_stream *s;
+ int_stream *s;
- s = get_mem (sizeof (unix_stream));
+ s = get_mem (sizeof (int_stream));
+ memset (s, '\0', sizeof (int_stream));
s->buffer = base;
s->buffer_offset = 0;
s->st.sfree = (void *) mem_sfree;
s->st.close = (void *) mem_close;
s->st.seek = (void *) mem_seek;
- s->st.truncate = (void *) mem_truncate;
+ s->st.trunc = (void *) mem_truncate;
+ s->st.read = (void *) mem_read;
+ s->st.write = (void *) mem_write;
+ s->st.set = (void *) mem_set;
return (stream *) s;
}
unix_stream *s;
s = get_mem (sizeof (unix_stream));
+ memset (s, '\0', sizeof (unix_stream));
s->fd = fd;
s->buffer_offset = 0;
/* Get the current length of the file. */
fstat (fd, &statbuf);
- s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
-#if HAVE_MMAP
- mmap_open (s);
-#else
+ 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);
-#endif
return (stream *) s;
}
+/* Given the Fortran unit number, convert it to a C file descriptor. */
+
+int
+unit_to_fd (int unit)
+{
+ gfc_unit *us;
+ int fd;
+
+ us = find_unit (unit);
+ if (us == NULL)
+ return -1;
+
+ fd = ((unix_stream *) us->s)->fd;
+ unlock_unit (us);
+ return fd;
+}
+
+
/* unpack_filename()-- Given a fortran string and a pointer to a
* buffer that is PATH_MAX characters, convert the fortran string to a
* C string in the buffer. Returns nonzero if this is not possible. */
-static int
+int
unpack_filename (char *cstring, const char *fstring, int len)
{
-
len = fstrlen (fstring, len);
if (len >= PATH_MAX)
return 1;
/* tempfile()-- Generate a temporary filename for a scratch file and
* open it. mkstemp() opens the file for reading and writing, but the
* library mode prevents anything that is not allowed. The descriptor
- * is returns, which is less than zero on error. The template is
- * pointed to by ioparm.file, which is copied into the unit structure
+ * is returned, which is -1 on error. The template is pointed to by
+ * 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 (tempdir == NULL)
tempdir = getenv ("TMP");
if (tempdir == NULL)
+ tempdir = getenv ("TEMP");
+ if (tempdir == NULL)
tempdir = DEFAULT_TEMPDIR;
template = get_mem (strlen (tempdir) + 20);
- st_sprintf (template, "%s/gfortantmpXXXXXX", tempdir);
+ sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
+
+#ifdef HAVE_MKSTEMP
fd = mkstemp (template);
+#else /* HAVE_MKSTEMP */
+
+ if (mktemp (template))
+ do
+#if defined(HAVE_CRLF) && defined(O_BINARY)
+ fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY,
+ S_IREAD | S_IWRITE);
+#else
+ fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
+#endif
+ while (!(fd == -1 && errno == EEXIST) && mktemp (template));
+ else
+ fd = -1;
+
+#endif /* HAVE_MKSTEMP */
+
if (fd < 0)
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;
}
-/* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
+/* regular_file()-- Open a regular file.
+ * Change flags->action if it is ACTION_UNSPECIFIED on entry,
+ * unless an error occurs.
+ * Returns the descriptor, which is less than zero on error. */
static int
-regular_file (unit_action action, unit_status status)
+regular_file (st_parameter_open *opp, unit_flags *flags)
{
char path[PATH_MAX + 1];
- struct stat statbuf;
int mode;
+ int rwflag;
+ 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;
}
- mode = 0;
+ rwflag = 0;
- switch (action)
+ switch (flags->action)
{
case ACTION_READ:
- mode = O_RDONLY;
+ rwflag = O_RDONLY;
break;
case ACTION_WRITE:
- mode = O_WRONLY;
+ rwflag = O_WRONLY;
break;
case ACTION_READWRITE:
- mode = O_RDWR;
+ case ACTION_UNSPECIFIED:
+ rwflag = O_RDWR;
break;
default:
- internal_error ("regular_file(): Bad action");
+ internal_error (&opp->common, "regular_file(): Bad action");
}
- switch (status)
+ switch (flags->status)
{
case STATUS_NEW:
- mode |= O_CREAT | O_EXCL;
+ crflag = O_CREAT | O_EXCL;
break;
- case STATUS_OLD: /* file must exist, so check for its existence */
- if (stat (path, &statbuf) < 0)
- return -1;
+ case STATUS_OLD: /* open will fail if the file does not exist*/
+ crflag = 0;
break;
case STATUS_UNKNOWN:
case STATUS_SCRATCH:
- mode |= O_CREAT;
+ crflag = O_CREAT;
break;
case STATUS_REPLACE:
- mode |= O_CREAT | O_TRUNC;
+ crflag = O_CREAT | O_TRUNC;
break;
default:
- internal_error ("regular_file(): Bad status");
+ internal_error (&opp->common, "regular_file(): Bad status");
}
- // mode |= O_LARGEFILE;
+ /* rwflag |= O_LARGEFILE; */
+
+#if defined(HAVE_CRLF) && defined(O_BINARY)
+ crflag |= O_BINARY;
+#endif
+
+ mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
+ fd = open (path, rwflag | crflag, mode);
+ if (flags->action != ACTION_UNSPECIFIED)
+ return fd;
+
+ if (fd >= 0)
+ {
+ flags->action = ACTION_READWRITE;
+ return fd;
+ }
+ if (errno != EACCES && errno != EROFS)
+ return fd;
- return open (path, mode,
- S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
+ /* retry for read-only access */
+ rwflag = O_RDONLY;
+ fd = open (path, rwflag | crflag, mode);
+ if (fd >=0)
+ {
+ flags->action = ACTION_READ;
+ return fd; /* success */
+ }
+
+ if (errno != EACCES)
+ return fd; /* failure */
+
+ /* retry for write-only access */
+ rwflag = O_WRONLY;
+ fd = open (path, rwflag | crflag, mode);
+ if (fd >=0)
+ {
+ flags->action = ACTION_WRITE;
+ return fd; /* success */
+ }
+ return fd; /* failure */
}
/* open_external()-- Open an external file, unix specific version.
+ * Change flags->action if it is ACTION_UNSPECIFIED on entry.
* Returns NULL on operating system error. */
stream *
-open_external (unit_action action, unit_status status)
+open_external (st_parameter_open *opp, unit_flags *flags)
{
int fd, prot;
- fd =
- (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
+ if (flags->status == STATUS_SCRATCH)
+ {
+ 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. */
+ 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 (opp, flags);
+ }
if (fd < 0)
return NULL;
fd = fix_fd (fd);
- switch (action)
+ switch (flags->action)
{
case ACTION_READ:
prot = PROT_READ;
break;
default:
- internal_error ("open_external(): Bad action");
+ internal_error (&opp->common, "open_external(): Bad action");
}
- /* If this is a scratch file, we can unlink it now and the file will
- * go away when it is closed. */
-
- if (status == STATUS_SCRATCH)
- unlink (ioparm.file);
-
return fd_to_stream (fd, prot);
}
stream *
input_stream (void)
{
-
return fd_to_stream (STDIN_FILENO, PROT_READ);
}
-/* output_stream()-- Return a stream pointer to the default input stream.
+/* output_stream()-- Return a stream pointer to the default output stream.
* Called on initialization. */
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);
}
-/* init_error_stream()-- Return a pointer to the error stream. This
- * subroutine is called when the stream is needed, rather than at
- * initialization. We want to work even if memory has been seriously
- * corrupted. */
+/* error_stream()-- Return a stream pointer to the default error stream.
+ * Called on initialization. */
stream *
-init_error_stream (void)
+error_stream (void)
+{
+#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
+ setmode (STDERR_FILENO, O_BINARY);
+#endif
+ return fd_to_stream (STDERR_FILENO, PROT_WRITE);
+}
+
+
+/* st_vprintf()-- vprintf function for error output. To avoid buffer
+ overruns, we limit the length of the buffer to ST_VPRINTF_SIZE. 2k
+ is big enough to completely fill a 80x25 terminal, so it shuld be
+ OK. We use a direct write() because it is simpler and least likely
+ to be clobbered by memory corruption. Writing an error message
+ longer than that is an error. */
+
+#define ST_VPRINTF_SIZE 2048
+
+int
+st_vprintf (const char *format, va_list ap)
{
- static unix_stream error;
+ static char buffer[ST_VPRINTF_SIZE];
+ int written;
+ int fd;
+
+ fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
+#ifdef HAVE_VSNPRINTF
+ written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap);
+#else
+ written = vsprintf(buffer, format, ap);
- memset (&error, '\0', sizeof (error));
+ if (written >= ST_VPRINTF_SIZE-1)
+ {
+ /* The error message was longer than our buffer. Ouch. Because
+ we may have messed up things badly, report the error and
+ quit. */
+#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n"
+ write (fd, buffer, ST_VPRINTF_SIZE-1);
+ write (fd, ERROR_MESSAGE, strlen(ERROR_MESSAGE));
+ sys_exit(2);
+#undef ERROR_MESSAGE
- error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
+ }
+#endif
- error.st.alloc_w_at = (void *) fd_alloc_w_at;
- error.st.sfree = (void *) fd_sfree;
+ written = write (fd, buffer, written);
+ return written;
+}
- error.unbuffered = 1;
- error.buffer = error.small_buffer;
+/* st_printf()-- printf() function for error output. This just calls
+ st_vprintf() to do the actual work. */
- return (stream *) & error;
+int
+st_printf (const char *format, ...)
+{
+ int written;
+ va_list ap;
+ va_start (ap, format);
+ written = st_vprintf(format, ap);
+ va_end (ap);
+ return written;
}
* 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);
}
{
unix_stream *us;
- us = (unix_stream *) s;
+ if (!is_seekable (s))
+ return 0;
- if (!us->mmaped)
- return 0; /* File is not seekable */
+ us = (unix_stream *) s;
return us->logical_offset == 0;
}
-/* 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
{
unix_stream *us;
- us = (unix_stream *) s;
+ if (!is_seekable (s))
+ return 0;
- if (!us->mmaped)
- return 0; /* File is not seekable */
+ us = (unix_stream *) s;
return us->logical_offset == us->dirty_offset;
}
* 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)
-static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
+static const char yes[] = "YES", no[] = "NO", unknown[] = "UNKNOWN";
/* inquire_sequential()-- Given a fortran string, determine if the
* file is suitable for sequential access. Returns a C-style
const char *
inquire_unformatted (const char *string, int len)
{
-
return inquire_formatted (string, len);
}
+#ifndef HAVE_ACCESS
+
+#ifndef W_OK
+#define W_OK 2
+#endif
+
+#ifndef R_OK
+#define R_OK 4
+#endif
+
+/* Fallback implementation of access() on systems that don't have it.
+ Only modes R_OK and W_OK are used in this file. */
+
+static int
+fallback_access (const char *path, int mode)
+{
+ if ((mode & R_OK) && open (path, O_RDONLY) < 0)
+ return -1;
+
+ if ((mode & W_OK) && open (path, O_WRONLY) < 0)
+ return -1;
+
+ return 0;
+}
+
+#undef access
+#define access fallback_access
+#endif
+
+
/* inquire_access()-- Given a fortran string, determine if the file is
* suitable for access. */
const char *
inquire_read (const char *string, int len)
{
-
return inquire_access (string, len, R_OK);
}
const char *
inquire_write (const char *string, int len)
{
-
return inquire_access (string, len, W_OK);
}
const char *
inquire_readwrite (const char *string, int len)
{
-
return inquire_access (string, len, R_OK | W_OK);
}
gfc_offset
file_length (stream * s)
{
-
return ((unix_stream *) s)->file_length;
}
/* file_position()-- Return the current position of the file */
gfc_offset
-file_position (stream * s)
+file_position (stream *s)
{
-
return ((unix_stream *) s)->logical_offset;
}
* it is not */
int
-is_seekable (stream * s)
+is_seekable (stream *s)
{
- /* by convention, if file_length == -1, the file is not seekable
- note that a mmapped file is always seekable, an fd_ file may
- or may not be. */
+ /* By convention, if file_length == -1, the file is not
+ seekable. */
return ((unix_stream *) s)->file_length!=-1;
}
+
+/* is_special()-- Return nonzero if the stream is not a regular file. */
+
+int
+is_special (stream *s)
+{
+ return ((unix_stream *) s)->special_file;
+}
+
+
try
flush (stream *s)
{
return fd_flush( (unix_stream *) s);
}
+int
+stream_isatty (stream *s)
+{
+ return isatty (((unix_stream *) s)->fd);
+}
+
+char *
+stream_ttyname (stream *s __attribute__ ((unused)))
+{
+#ifdef HAVE_TTYNAME
+ return ttyname (((unix_stream *) s)->fd);
+#else
+ return NULL;
+#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
