-/* Copyright (C) 2002, 2003, 2004, 2005
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Contributed by Andy Vaught
+ F2003 I/O support contributed by Jerry DeLisle
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, 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
GNU General Public License for more details.
-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, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
/* Unix stream I/O module */
-#include "config.h"
+#include "io.h"
+#include "unix.h"
#include <stdlib.h>
#include <limits.h>
#include <unistd.h>
-#include <stdio.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <assert.h>
#include <string.h>
#include <errno.h>
-#include "libgfortran.h"
-#include "io.h"
-#include "unix.h"
-#ifndef SSIZE_MAX
-#define SSIZE_MAX SHRT_MAX
+/* For mingw, we don't identify files by their inode number, but by a
+ 64-bit identifier created from a BY_HANDLE_FILE_INFORMATION. */
+#ifdef __MINGW32__
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+#define lseek _lseeki64
+#define fstat _fstati64
+#define stat _stati64
+typedef struct _stati64 gfstat_t;
+
+#ifndef HAVE_WORKING_STAT
+static uint64_t
+id_from_handle (HANDLE hFile)
+{
+ BY_HANDLE_FILE_INFORMATION FileInformation;
+
+ if (hFile == INVALID_HANDLE_VALUE)
+ return 0;
+
+ memset (&FileInformation, 0, sizeof(FileInformation));
+ if (!GetFileInformationByHandle (hFile, &FileInformation))
+ return 0;
+
+ return ((uint64_t) FileInformation.nFileIndexLow)
+ | (((uint64_t) FileInformation.nFileIndexHigh) << 32);
+}
+
+
+static uint64_t
+id_from_path (const char *path)
+{
+ HANDLE hFile;
+ uint64_t res;
+
+ if (!path || !*path || access (path, F_OK))
+ return (uint64_t) -1;
+
+ hFile = CreateFile (path, 0, 0, NULL, OPEN_EXISTING,
+ FILE_FLAG_BACKUP_SEMANTICS | FILE_ATTRIBUTE_READONLY,
+ NULL);
+ res = id_from_handle (hFile);
+ CloseHandle (hFile);
+ return res;
+}
+
+
+static uint64_t
+id_from_fd (const int fd)
+{
+ return id_from_handle ((HANDLE) _get_osfhandle (fd));
+}
+
+#endif
+
+#else
+typedef struct stat gfstat_t;
#endif
#ifndef PATH_MAX
#define S_IWOTH 0
#endif
-/* This implementation of stream I/O is based on the paper:
- *
- * "Exploiting the advantages of mapped files for stream I/O",
- * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
- * USENIX conference", p. 27-42.
- *
- * It differs in a number of ways from the version described in the
- * paper. First of all, threads are not an issue during I/O and we
- * also don't have to worry about having multiple regions, since
- * fortran's I/O model only allows you to be one place at a time.
- *
- * On the other hand, we have to be able to writing at the end of a
- * stream, read from the start of a stream or read and write blocks of
- * bytes from an arbitrary position. After opening a file, a pointer
- * to a stream structure is returned, which is used to handle file
- * accesses until the file is closed.
- *
- * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
- * pointer to a block of memory that mirror the file at position
- * 'where' that is 'len' bytes long. The len integer is updated to
- * reflect how many bytes were actually read. The only reason for a
- * short read is end of file. The file pointer is updated. The
- * pointer is valid until the next call to salloc_*.
- *
- * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
- * a pointer to a block of memory that is updated to reflect the state
- * of the file. The length of the buffer is always equal to that
- * requested. The buffer must be completely set by the caller. When
- * data has been written, the sfree() function must be called to
- * indicate that the caller is done writing data to the buffer. This
- * may or may not cause a physical write.
- *
- * Short forms of these are salloc_r() and salloc_w() which drop the
- * 'where' parameter and use the current file pointer. */
-
-
-/*move_pos_offset()-- Move the record pointer right or left
- *relative to current position */
-int
-move_pos_offset (stream* st, int pos_off)
+/* Unix and internal stream I/O module */
+
+static const int BUFFER_SIZE = 8192;
+
+typedef struct
{
- unix_stream * str = (unix_stream*)st;
- if (pos_off < 0)
- {
- str->logical_offset += pos_off;
+ stream st;
- if (str->dirty_offset + str->ndirty > str->logical_offset)
- {
- if (str->ndirty + pos_off > 0)
- str->ndirty += pos_off;
- else
- {
- str->dirty_offset += pos_off + pos_off;
- str->ndirty = 0;
- }
- }
+ 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 file_length; /* Length of the file, -1 if not seekable. */
- return pos_off;
- }
- return 0;
+ char *buffer; /* Pointer to the buffer. */
+ int fd; /* The POSIX file descriptor. */
+
+ int active; /* Length of valid bytes in the buffer */
+
+ int prot;
+ int ndirty; /* Dirty bytes starting at buffer_offset */
+
+ int special_file; /* =1 if the fd refers to a special file */
}
+unix_stream;
/* fix_fd()-- Given a file descriptor, make sure it is not one of the
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. */
-
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;
-
- fd = ((unix_stream *) s)->fd;
- if (fd == STDIN_FILENO || fd == STDOUT_FILENO || fd == STDERR_FILENO)
- return 1;
- else
- return 0;
-}
/* If the stream corresponds to a preconnected unit, we flush the
corresponding C stream. This is bugware for mixed C-Fortran codes
}
-/* Reset a stream after reading/writing. Assumes that the buffers have
- been flushed. */
+/* get_oserror()-- Get the most recent operating system error. For
+ * unix, this is errno. */
-inline static void
-reset_stream (unix_stream * s, size_t bytes_rw)
+const char *
+get_oserror (void)
{
- 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;
+ return strerror (errno);
}
-/* 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. */
+/********************************************************************
+Raw I/O functions (read, write, seek, tell, truncate, close).
+
+These functions wrap the basic POSIX I/O syscalls. Any deviation in
+semantics is a bug, except the following: write restarts in case
+of being interrupted by a signal, and as the first argument the
+functions take the unix_stream struct rather than an integer file
+descriptor. Also, for POSIX read() and write() a nbyte argument larger
+than SSIZE_MAX is undefined; here the type of nbyte is ssize_t rather
+than size_t as for POSIX read/write.
+*********************************************************************/
static int
-do_read (unix_stream * s, void * buf, size_t * nbytes)
+raw_flush (unix_stream * s __attribute__ ((unused)))
{
- 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;
- }
-
- *nbytes -= bytes_left;
- return status;
+ return 0;
}
+static ssize_t
+raw_read (unix_stream * s, void * buf, ssize_t nbyte)
+{
+ /* For read we can't do I/O in a loop like raw_write does, because
+ that will break applications that wait for interactive I/O. */
+ return read (s->fd, buf, nbyte);
+}
-/* Write a buffer to a stream, allowing for short writes. */
-
-static int
-do_write (unix_stream * s, const void * buf, size_t * nbytes)
+static ssize_t
+raw_write (unix_stream * s, const void * buf, ssize_t nbyte)
{
- ssize_t trans;
- size_t bytes_left;
+ ssize_t trans, bytes_left;
char *buf_st;
- int status;
- status = 0;
- bytes_left = *nbytes;
+ bytes_left = nbyte;
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);
+ trans = write (s->fd, buf_st, bytes_left);
if (trans < 0)
{
if (errno == EINTR)
continue;
else
- {
- status = errno;
- break;
- }
+ return trans;
}
buf_st += trans;
bytes_left -= trans;
}
- *nbytes -= bytes_left;
- return status;
-}
-
-
-/* get_oserror()-- Get the most recent operating system error. For
- * unix, this is errno. */
-
-const char *
-get_oserror (void)
-{
- return strerror (errno);
+ return nbyte - bytes_left;
}
-
-/* sys_exit()-- Terminate the program with an exit code */
-
-void
-sys_exit (int code)
+static gfc_offset
+raw_seek (unix_stream * s, gfc_offset offset, int whence)
{
- exit (code);
+ return lseek (s->fd, offset, whence);
}
-
-/*********************************************************************
- File descriptor stream functions
-*********************************************************************/
-
-
-/* fd_flush()-- Write bytes that need to be written */
-
-static try
-fd_flush (unix_stream * s)
+static gfc_offset
+raw_tell (unix_stream * s)
{
- size_t writelen;
-
- if (s->ndirty == 0)
- return SUCCESS;;
-
- if (s->physical_offset != s->dirty_offset &&
- lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
- return FAILURE;
-
- 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 + 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 -= writelen;
- if (s->ndirty != 0)
- return FAILURE;
-
- return SUCCESS;
+ return lseek (s->fd, 0, SEEK_CUR);
}
-
-/* fd_alloc()-- Arrange a buffer such that the salloc() request can be
- * satisfied. This subroutine gets the buffer ready for whatever is
- * to come next. */
-
-static void
-fd_alloc (unix_stream * s, gfc_offset where,
- int *len __attribute__ ((unused)))
+static int
+raw_truncate (unix_stream * s, gfc_offset length)
{
- char *new_buffer;
- int n, read_len;
+#ifdef __MINGW32__
+ HANDLE h;
+ gfc_offset cur;
- if (*len <= BUFFER_SIZE)
+ if (isatty (s->fd))
{
- new_buffer = s->small_buffer;
- read_len = BUFFER_SIZE;
+ errno = EBADF;
+ return -1;
}
- else
+ h = _get_osfhandle (s->fd);
+ if (h == INVALID_HANDLE_VALUE)
{
- new_buffer = get_mem (*len);
- read_len = *len;
+ errno = EBADF;
+ return -1;
}
-
- /* Salvage bytes currently within the buffer. This is important for
- * devices that cannot seek. */
-
- if (s->buffer != NULL && s->buffer_offset <= where &&
- where <= s->buffer_offset + s->active)
+ cur = lseek (s->fd, 0, SEEK_CUR);
+ if (cur == -1)
+ return -1;
+ if (lseek (s->fd, length, SEEK_SET) == -1)
+ goto error;
+ if (!SetEndOfFile (h))
{
-
- n = s->active - (where - s->buffer_offset);
- memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
-
- s->active = n;
- }
- else
- { /* new buffer starts off empty */
- s->active = 0;
+ errno = EBADF;
+ goto error;
}
-
- s->buffer_offset = where;
-
- /* free the old buffer if necessary */
-
- if (s->buffer != NULL && s->buffer != s->small_buffer)
- free_mem (s->buffer);
-
- s->buffer = new_buffer;
- s->len = read_len;
+ if (lseek (s->fd, cur, SEEK_SET) == -1)
+ return -1;
+ return 0;
+ error:
+ lseek (s->fd, cur, SEEK_SET);
+ return -1;
+#elif defined HAVE_FTRUNCATE
+ return ftruncate (s->fd, length);
+#elif defined HAVE_CHSIZE
+ return chsize (s->fd, length);
+#else
+ runtime_error ("required ftruncate or chsize support not present");
+ return -1;
+#endif
}
-
-/* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
- * we've already buffered the data or we need to load it. Returns
- * NULL on I/O error. */
-
-static char *
-fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
+static int
+raw_close (unix_stream * s)
{
- gfc_offset m;
-
- if (where == -1)
- where = s->logical_offset;
-
- if (s->buffer != NULL && s->buffer_offset <= where &&
- where + *len <= s->buffer_offset + s->active)
- {
-
- /* Return a position within the current buffer */
-
- s->logical_offset = where + *len;
- return s->buffer + where - s->buffer_offset;
- }
-
- fd_alloc (s, where, len);
-
- m = where + s->active;
-
- if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 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->active += n;
- }
+ int retval;
+
+ if (s->fd != STDOUT_FILENO
+ && s->fd != STDERR_FILENO
+ && s->fd != STDIN_FILENO)
+ retval = close (s->fd);
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;
- }
-
- if (s->active < *len)
- *len = s->active; /* Bytes actually available */
-
- s->logical_offset = where + *len;
-
- return s->buffer;
+ retval = 0;
+ free_mem (s);
+ return retval;
}
-
-/* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
- * we've already buffered the data or we need to load it. */
-
-static char *
-fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
+static int
+raw_init (unix_stream * s)
{
- gfc_offset n;
-
- if (where == -1)
- where = s->logical_offset;
-
- if (s->buffer == NULL || s->buffer_offset > where ||
- where + *len > s->buffer_offset + s->len)
- {
+ s->st.read = (void *) raw_read;
+ s->st.write = (void *) raw_write;
+ s->st.seek = (void *) raw_seek;
+ s->st.tell = (void *) raw_tell;
+ s->st.trunc = (void *) raw_truncate;
+ s->st.close = (void *) raw_close;
+ s->st.flush = (void *) raw_flush;
- if (fd_flush (s) == FAILURE)
- return NULL;
- fd_alloc (s, where, len);
- }
-
- /* Return a position within the current buffer */
- if (s->ndirty == 0
- || where > s->dirty_offset + s->ndirty
- || s->dirty_offset > where + *len)
- { /* Discontiguous blocks, start with a clean buffer. */
- /* Flush the buffer. */
- if (s->ndirty != 0)
- fd_flush (s);
- s->dirty_offset = where;
- s->ndirty = *len;
- }
- else
- {
- gfc_offset start; /* Merge with the existing data. */
- if (where < s->dirty_offset)
- start = where;
- else
- start = s->dirty_offset;
- if (where + *len > s->dirty_offset + s->ndirty)
- s->ndirty = where + *len - start;
- else
- s->ndirty = s->dirty_offset + s->ndirty - start;
- s->dirty_offset = start;
- }
-
- s->logical_offset = where + *len;
-
- if (where + *len > s->file_length)
- s->file_length = where + *len;
-
- n = s->logical_offset - s->buffer_offset;
- if (n > s->active)
- s->active = n;
-
- return s->buffer + where - s->buffer_offset;
+ s->buffer = NULL;
+ return 0;
}
-static try
-fd_sfree (unix_stream * s)
-{
- if (s->ndirty != 0 &&
- (s->buffer != s->small_buffer || options.all_unbuffered ||
- s->unbuffered))
- return fd_flush (s);
-
- return SUCCESS;
-}
-
+/*********************************************************************
+Buffered I/O functions. These functions have the same semantics as the
+raw I/O functions above, except that they are buffered in order to
+improve performance. The buffer must be flushed when switching from
+reading to writing and vice versa.
+*********************************************************************/
-static try
-fd_seek (unix_stream * s, gfc_offset offset)
+static int
+buf_flush (unix_stream * s)
{
- if (s->physical_offset == offset) /* Are we lucky and avoid syscall? */
- {
- s->logical_offset = offset;
- return SUCCESS;
- }
+ int writelen;
- s->physical_offset = s->logical_offset = offset;
+ /* Flushing in read mode means discarding read bytes. */
s->active = 0;
- return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
-}
+ if (s->ndirty == 0)
+ return 0;
+
+ if (s->file_length != -1 && s->physical_offset != s->buffer_offset
+ && lseek (s->fd, s->buffer_offset, SEEK_SET) < 0)
+ return -1;
+ writelen = raw_write (s, s->buffer, s->ndirty);
-/* truncate_file()-- Given a unit, truncate the file at the current
- * position. Sets the physical location to the new end of the file.
- * Returns nonzero on error. */
+ s->physical_offset = s->buffer_offset + writelen;
-static try
-fd_truncate (unix_stream * s)
-{
- if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
- return FAILURE;
+ /* 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;
- /* 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 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
- {
- s->physical_offset = s->file_length = 0;
- return SUCCESS;
- }
+ s->ndirty -= writelen;
+ if (s->ndirty != 0)
+ return -1;
- s->physical_offset = s->file_length = s->logical_offset;
- s->active = 0;
- return SUCCESS;
+ return 0;
}
-
-/* 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)
+static ssize_t
+buf_read (unix_stream * s, void * buf, ssize_t nbyte)
{
- size_t bytes_left;
- int trans;
- void *p;
+ if (s->active == 0)
+ s->buffer_offset = s->logical_offset;
- bytes_left = n;
-
- while (bytes_left > 0)
+ /* Is the data we want in the buffer? */
+ if (s->logical_offset + nbyte <= s->buffer_offset + s->active
+ && s->buffer_offset <= s->logical_offset)
+ memcpy (buf, s->buffer + (s->logical_offset - s->buffer_offset), nbyte);
+ else
{
- /* 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);
+ /* First copy the active bytes if applicable, then read the rest
+ either directly or filling the buffer. */
+ char *p;
+ int nread = 0;
+ ssize_t to_read, did_read;
+ gfc_offset new_logical;
+
+ p = (char *) buf;
+ if (s->logical_offset >= s->buffer_offset
+ && s->buffer_offset + s->active >= s->logical_offset)
+ {
+ nread = s->active - (s->logical_offset - s->buffer_offset);
+ memcpy (buf, s->buffer + (s->logical_offset - s->buffer_offset),
+ nread);
+ p += nread;
+ }
+ /* At this point we consider all bytes in the buffer discarded. */
+ to_read = nbyte - nread;
+ new_logical = s->logical_offset + nread;
+ if (s->file_length != -1 && s->physical_offset != new_logical
+ && lseek (s->fd, new_logical, SEEK_SET) < 0)
+ return -1;
+ s->buffer_offset = s->physical_offset = new_logical;
+ if (to_read <= BUFFER_SIZE/2)
+ {
+ did_read = raw_read (s, s->buffer, BUFFER_SIZE);
+ s->physical_offset += did_read;
+ s->active = did_read;
+ did_read = (did_read > to_read) ? to_read : did_read;
+ memcpy (p, s->buffer, did_read);
+ }
else
- return FAILURE;
-
- bytes_left -= trans;
+ {
+ did_read = raw_read (s, p, to_read);
+ s->physical_offset += did_read;
+ s->active = 0;
+ }
+ nbyte = did_read + nread;
}
-
- return SUCCESS;
+ s->logical_offset += nbyte;
+ return nbyte;
}
-
-/* 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)
+static ssize_t
+buf_write (unix_stream * s, const void * buf, ssize_t nbyte)
{
- void *p;
- int tmp, status;
-
- if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+ if (s->ndirty == 0)
+ s->buffer_offset = s->logical_offset;
+
+ /* Does the data fit into the buffer? As a special case, if the
+ buffer is empty and the request is bigger than BUFFER_SIZE/2,
+ write directly. This avoids the case where the buffer would have
+ to be flushed at every write. */
+ if (!(s->ndirty == 0 && nbyte > BUFFER_SIZE/2)
+ && s->logical_offset + nbyte <= s->buffer_offset + BUFFER_SIZE
+ && s->buffer_offset <= s->logical_offset
+ && s->buffer_offset + s->ndirty >= s->logical_offset)
{
- tmp = *nbytes;
- p = fd_alloc_r_at (s, &tmp, -1);
- if (p)
- {
- *nbytes = tmp;
- memcpy (buf, p, *nbytes);
- return 0;
- }
+ memcpy (s->buffer + (s->logical_offset - s->buffer_offset), buf, nbyte);
+ int nd = (s->logical_offset - s->buffer_offset) + nbyte;
+ if (nd > s->ndirty)
+ s->ndirty = nd;
+ }
+ else
+ {
+ /* Flush, and either fill the buffer with the new data, or if
+ the request is bigger than the buffer size, write directly
+ bypassing the buffer. */
+ buf_flush (s);
+ if (nbyte <= BUFFER_SIZE/2)
+ {
+ memcpy (s->buffer, buf, nbyte);
+ s->buffer_offset = s->logical_offset;
+ s->ndirty += nbyte;
+ }
else
{
- *nbytes = 0;
- return errno;
+ if (s->file_length != -1 && s->physical_offset != s->logical_offset)
+ {
+ if (lseek (s->fd, s->logical_offset, SEEK_SET) < 0)
+ return -1;
+ s->physical_offset = s->logical_offset;
+ }
+
+ nbyte = raw_write (s, buf, nbyte);
+ s->physical_offset += nbyte;
}
}
+ s->logical_offset += nbyte;
+ /* 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;
+ return nbyte;
+}
- /* If the request is bigger than BUFFER_SIZE we flush the buffers
- and read directly. */
- if (fd_flush (s) == FAILURE)
+static gfc_offset
+buf_seek (unix_stream * s, gfc_offset offset, int whence)
+{
+ switch (whence)
{
- *nbytes = 0;
- return errno;
+ case SEEK_SET:
+ break;
+ case SEEK_CUR:
+ offset += s->logical_offset;
+ break;
+ case SEEK_END:
+ offset += s->file_length;
+ break;
+ default:
+ return -1;
}
-
- if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
+ if (offset < 0)
{
- *nbytes = 0;
- return errno;
+ errno = EINVAL;
+ return -1;
}
-
- status = do_read (s, buf, nbytes);
- reset_stream (s, *nbytes);
- return status;
+ s->logical_offset = offset;
+ return offset;
}
-
-/* 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 gfc_offset
+buf_tell (unix_stream * s)
+{
+ return s->logical_offset;
+}
static int
-fd_write (unix_stream * s, const void * buf, size_t * nbytes)
+buf_truncate (unix_stream * s, gfc_offset length)
{
- void *p;
- int tmp, status;
+ int r;
- if (*nbytes < BUFFER_SIZE && !s->unbuffered)
- {
- 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;
- }
- }
-
- /* If the request is bigger than BUFFER_SIZE we flush the buffers
- and write 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_write (s, buf, nbytes);
- reset_stream (s, *nbytes);
- return status;
+ if (buf_flush (s) != 0)
+ return -1;
+ r = raw_truncate (s, length);
+ if (r == 0)
+ s->file_length = length;
+ return r;
}
-
-static try
-fd_close (unix_stream * s)
+static int
+buf_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;
+ if (buf_flush (s) != 0)
+ return -1;
+ free_mem (s->buffer);
+ return raw_close (s);
}
-
-static void
-fd_open (unix_stream * s)
+static int
+buf_init (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->st.read = (void *) fd_read;
- s->st.write = (void *) fd_write;
- s->st.set = (void *) fd_sset;
+ s->st.read = (void *) buf_read;
+ s->st.write = (void *) buf_write;
+ s->st.seek = (void *) buf_seek;
+ s->st.tell = (void *) buf_tell;
+ s->st.trunc = (void *) buf_truncate;
+ s->st.close = (void *) buf_close;
+ s->st.flush = (void *) buf_flush;
- s->buffer = NULL;
+ s->buffer = get_mem (BUFFER_SIZE);
+ return 0;
}
-
-
/*********************************************************************
memory stream functions - These are used for internal files
*********************************************************************/
-static char *
-mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
+char *
+mem_alloc_r (stream * strm, int * len)
{
+ unix_stream * s = (unix_stream *) strm;
gfc_offset n;
-
- if (where == -1)
- where = s->logical_offset;
+ gfc_offset where = s->logical_offset;
if (where < s->buffer_offset || where > s->buffer_offset + s->active)
return NULL;
- s->logical_offset = where + *len;
-
n = s->buffer_offset + s->active - where;
if (*len > n)
*len = n;
+ s->logical_offset = where + *len;
+
return s->buffer + (where - s->buffer_offset);
}
-static char *
-mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
+char *
+mem_alloc_w (stream * strm, int * len)
{
+ unix_stream * s = (unix_stream *) strm;
gfc_offset m;
-
- assert (*len >= 0); /* Negative values not allowed. */
-
- if (where == -1)
- where = s->logical_offset;
+ gfc_offset where = s->logical_offset;
m = where + *len;
}
-/* 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. */
+/* Stream read function for internal units. */
-static int
-mem_read (unix_stream * s, void * buf, size_t * nbytes)
+static ssize_t
+mem_read (stream * s, void * buf, ssize_t nbytes)
{
void *p;
- int tmp;
+ int nb = nbytes;
- tmp = *nbytes;
- p = mem_alloc_r_at (s, &tmp, -1);
+ p = mem_alloc_r (s, &nb);
if (p)
{
- *nbytes = tmp;
- memcpy (buf, p, *nbytes);
- return 0;
+ memcpy (buf, p, nb);
+ return (ssize_t) nb;
}
else
- {
- *nbytes = 0;
- return errno;
- }
+ return 0;
}
at the moment, as all internal IO is formatted and the formatted IO
routines use mem_alloc_w_at. */
-static int
-mem_write (unix_stream * s, const void * buf, size_t * nbytes)
+static ssize_t
+mem_write (stream * s, const void * buf, ssize_t nbytes)
{
void *p;
- int tmp;
-
- errno = 0;
+ int nb = nbytes;
- tmp = *nbytes;
- p = mem_alloc_w_at (s, &tmp, -1);
+ p = mem_alloc_w (s, &nb);
if (p)
{
- *nbytes = tmp;
- memcpy (p, buf, *nbytes);
- return 0;
+ memcpy (p, buf, nb);
+ return (ssize_t) nb;
}
else
- {
- *nbytes = 0;
- return errno;
- }
+ return 0;
}
-static int
-mem_seek (unix_stream * s, gfc_offset offset)
+static gfc_offset
+mem_seek (stream * strm, gfc_offset offset, int whence)
{
+ unix_stream * s = (unix_stream *) strm;
+ switch (whence)
+ {
+ case SEEK_SET:
+ break;
+ case SEEK_CUR:
+ offset += s->logical_offset;
+ break;
+ case SEEK_END:
+ offset += s->file_length;
+ break;
+ default:
+ return -1;
+ }
+
+ /* Note that for internal array I/O it's actually possible to have a
+ negative offset, so don't check for that. */
if (offset > s->file_length)
{
- errno = ESPIPE;
- return FAILURE;
+ errno = EINVAL;
+ return -1;
}
s->logical_offset = offset;
- return SUCCESS;
+
+ /* Returning < 0 is the error indicator for sseek(), so return 0 if
+ offset is negative. Thus if the return value is 0, the caller
+ has to use stell() to get the real value of logical_offset. */
+ if (offset >= 0)
+ return offset;
+ return 0;
}
-static try
-mem_set (unix_stream * s, int c, size_t n)
+static gfc_offset
+mem_tell (stream * s)
{
- void *p;
- int len;
+ return ((unix_stream *)s)->logical_offset;
+}
- 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)),
+ gfc_offset length __attribute__ ((unused)))
+{
+ return 0;
}
static int
-mem_truncate (unix_stream * s __attribute__ ((unused)))
+mem_flush (unix_stream * s __attribute__ ((unused)))
{
- return SUCCESS;
+ return 0;
}
-static try
+static int
mem_close (unix_stream * s)
{
if (s != NULL)
free_mem (s);
- return SUCCESS;
-}
-
-
-static try
-mem_sfree (unix_stream * s __attribute__ ((unused)))
-{
- return SUCCESS;
+ return 0;
}
-
/*********************************************************************
Public functions -- A reimplementation of this module needs to
define functional equivalents of the following.
/* open_internal()-- Returns a stream structure from an internal file */
stream *
-open_internal (char *base, int length)
+open_internal (char *base, int length, gfc_offset offset)
{
unix_stream *s;
memset (s, '\0', sizeof (unix_stream));
s->buffer = base;
- s->buffer_offset = 0;
+ s->buffer_offset = offset;
s->logical_offset = 0;
s->active = s->file_length = length;
- s->st.alloc_r_at = (void *) mem_alloc_r_at;
- s->st.alloc_w_at = (void *) mem_alloc_w_at;
- 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.tell = (void *) mem_tell;
+ s->st.trunc = (void *) mem_truncate;
s->st.read = (void *) mem_read;
s->st.write = (void *) mem_write;
- s->st.set = (void *) mem_set;
+ s->st.flush = (void *) mem_flush;
return (stream *) s;
}
static stream *
fd_to_stream (int fd, int prot)
{
- struct stat statbuf;
+ gfstat_t statbuf;
unix_stream *s;
s = get_mem (sizeof (unix_stream));
/* 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) == (gfc_offset) -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);
+ if (isatty (s->fd) || options.all_unbuffered
+ ||(options.unbuffered_preconnected &&
+ (s->fd == STDIN_FILENO
+ || s->fd == STDOUT_FILENO
+ || s->fd == STDERR_FILENO)))
+ raw_init (s);
+ else
+ buf_init (s);
return (stream *) s;
}
template = get_mem (strlen (tempdir) + 20);
- st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
-
#ifdef HAVE_MKSTEMP
+ sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
fd = mkstemp (template);
#else /* HAVE_MKSTEMP */
-
- if (mktemp (template))
- do
+ fd = -1;
+ do
+ {
+ sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
+ if (!mktemp (template))
+ break;
#if defined(HAVE_CRLF) && defined(O_BINARY)
fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY,
- S_IREAD | S_IWRITE);
+ 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;
+ }
+ while (fd == -1 && errno == EEXIST);
#endif /* HAVE_MKSTEMP */
return -1;
}
+#ifdef __CYGWIN__
+ if (opp->file_len == 7)
+ {
+ if (strncmp (path, "CONOUT$", 7) == 0
+ || strncmp (path, "CONERR$", 7) == 0)
+ {
+ fd = open ("/dev/conout", O_WRONLY);
+ flags->action = ACTION_WRITE;
+ return fd;
+ }
+ }
+
+ if (opp->file_len == 6 && strncmp (path, "CONIN$", 6) == 0)
+ {
+ fd = open ("/dev/conin", O_RDONLY);
+ flags->action = ACTION_READ;
+ return fd;
+ }
+#endif
+
+
+#ifdef __MINGW32__
+ if (opp->file_len == 7)
+ {
+ if (strncmp (path, "CONOUT$", 7) == 0
+ || strncmp (path, "CONERR$", 7) == 0)
+ {
+ fd = open ("CONOUT$", O_WRONLY);
+ flags->action = ACTION_WRITE;
+ return fd;
+ }
+ }
+
+ if (opp->file_len == 6 && strncmp (path, "CONIN$", 6) == 0)
+ {
+ fd = open ("CONIN$", O_RDONLY);
+ flags->action = ACTION_READ;
+ return fd;
+ }
+#endif
+
rwflag = 0;
switch (flags->action)
break;
case STATUS_REPLACE:
- crflag = O_CREAT | O_TRUNC;
+ crflag = O_CREAT | O_TRUNC;
break;
default:
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;
+ return fd;
if (fd >= 0)
{
flags->action = ACTION_READWRITE;
return fd;
}
- if (errno != EACCES)
+ if (errno != EACCES && errno != EROFS)
return fd;
/* retry for read-only access */
if (fd >=0)
{
flags->action = ACTION_READ;
- return fd; /* success */
+ return fd; /* success */
}
if (errno != EACCES)
- return fd; /* failure */
+ return fd; /* failure */
/* retry for write-only access */
rwflag = O_WRONLY;
if (fd >=0)
{
flags->action = ACTION_WRITE;
- return fd; /* success */
+ return fd; /* success */
}
- return fd; /* failure */
+ return fd; /* failure */
}
{
fd = tempfile (opp);
if (flags->action == ACTION_UNSPECIFIED)
- flags->action = ACTION_READWRITE;
+ flags->action = ACTION_READWRITE;
#if HAVE_UNLINK_OPEN_FILE
/* We can unlink scratch files now and it will go away when closed. */
stream *
output_stream (void)
{
+ stream * s;
+
#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
setmode (STDOUT_FILENO, O_BINARY);
#endif
- return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
+
+ s = fd_to_stream (STDOUT_FILENO, PROT_WRITE);
+ return s;
}
stream *
error_stream (void)
{
+ stream * s;
+
#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
setmode (STDERR_FILENO, O_BINARY);
#endif
- return fd_to_stream (STDERR_FILENO, PROT_WRITE);
+
+ s = fd_to_stream (STDERR_FILENO, PROT_WRITE);
+ return s;
}
-/* 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. */
-stream *
-init_error_stream (unix_stream *error)
+/* 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)
{
- memset (error, '\0', sizeof (*error));
+ static char buffer[ST_VPRINTF_SIZE];
+ int written;
+ int fd;
- error->fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
+ 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);
- error->st.alloc_w_at = (void *) fd_alloc_w_at;
- error->st.sfree = (void *) fd_sfree;
+ 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->unbuffered = 1;
- error->buffer = error->small_buffer;
+ }
+#endif
- return (stream *) error;
+ written = write (fd, buffer, written);
+ return written;
+}
+
+/* st_printf()-- printf() function for error output. This just calls
+ st_vprintf() to do the actual work. */
+
+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;
}
compare_file_filename (gfc_unit *u, const char *name, int len)
{
char path[PATH_MAX + 1];
- struct stat st1;
+ gfstat_t st1;
#ifdef HAVE_WORKING_STAT
- struct stat st2;
+ gfstat_t st2;
+#else
+# ifdef __MINGW32__
+ uint64_t id1, id2;
+# endif
#endif
if (unpack_filename (path, name, len))
fstat (((unix_stream *) (u->s))->fd, &st2);
return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
#else
+
+# ifdef __MINGW32__
+ /* We try to match files by a unique ID. On some filesystems (network
+ fs and FAT), we can't generate this unique ID, and will simply compare
+ filenames. */
+ id1 = id_from_path (path);
+ id2 = id_from_fd (((unix_stream *) (u->s))->fd);
+ if (id1 || id2)
+ return (id1 == id2);
+# endif
+
if (len != u->file_len)
return 0;
return (memcmp(path, u->file, len) == 0);
#ifdef HAVE_WORKING_STAT
-# define FIND_FILE0_DECL struct stat *st
+# define FIND_FILE0_DECL gfstat_t *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
+# define FIND_FILE0_DECL uint64_t id, const char *file, gfc_charlen_type file_len
+# define FIND_FILE0_ARGS id, file, file_len
#endif
/* find_file0()-- Recursive work function for find_file() */
find_file0 (gfc_unit *u, FIND_FILE0_DECL)
{
gfc_unit *v;
+#if defined(__MINGW32__) && !HAVE_WORKING_STAT
+ uint64_t id1;
+#endif
if (u == NULL)
return NULL;
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;
+# ifdef __MINGW32__
+ if (u->s && ((id1 = id_from_fd (((unix_stream *) u->s)->fd)) || id1))
+ {
+ if (id == id1)
+ return u;
+ }
+ else
+# endif
+ if (compare_string (u->file_len, u->file, file_len, file) == 0)
+ return u;
#endif
v = find_file0 (u->left, FIND_FILE0_ARGS);
find_file (const char *file, gfc_charlen_type file_len)
{
char path[PATH_MAX + 1];
- struct stat st[2];
+ gfstat_t st[2];
gfc_unit *u;
+#if defined(__MINGW32__) && !HAVE_WORKING_STAT
+ uint64_t id = 0ULL;
+#endif
if (unpack_filename (path, file, file_len))
return NULL;
if (stat (path, &st[0]) < 0)
return NULL;
+#if defined(__MINGW32__) && !HAVE_WORKING_STAT
+ id = id_from_path (path);
+#endif
+
__gthread_mutex_lock (&unit_lock);
retry:
u = find_file0 (unit_root, FIND_FILE0_ARGS);
if (__gthread_mutex_trylock (&u->lock))
return u;
if (u->s)
- flush (u->s);
+ sflush (u->s);
__gthread_mutex_unlock (&u->lock);
}
u = u->right;
if (u->closed == 0)
{
- flush (u->s);
+ sflush (u->s);
__gthread_mutex_lock (&unit_lock);
__gthread_mutex_unlock (&u->lock);
(void) predec_waiting_locked (u);
}
-/* stream_at_bof()-- Returns nonzero if the stream is at the beginning
- * of the file. */
-
-int
-stream_at_bof (stream * s)
-{
- unix_stream *us;
-
- if (!is_seekable (s))
- return 0;
-
- us = (unix_stream *) s;
-
- return us->logical_offset == 0;
-}
-
-
-/* stream_at_eof()-- Returns nonzero if the stream is at the end
- * of the file. */
-
-int
-stream_at_eof (stream * s)
-{
- unix_stream *us;
-
- if (!is_seekable (s))
- return 0;
-
- us = (unix_stream *) s;
-
- return us->logical_offset == us->dirty_offset;
-}
-
-
/* delete_file()-- Given a unit structure, delete the file associated
* with the unit. Returns nonzero if something went wrong. */
file_exists (const char *file, gfc_charlen_type file_len)
{
char path[PATH_MAX + 1];
- struct stat statbuf;
+ gfstat_t statbuf;
if (unpack_filename (path, file, file_len))
return 0;
}
+/* file_size()-- Returns the size of the file. */
+
+GFC_IO_INT
+file_size (const char *file, gfc_charlen_type file_len)
+{
+ char path[PATH_MAX + 1];
+ gfstat_t statbuf;
+
+ if (unpack_filename (path, file, file_len))
+ return -1;
+
+ if (stat (path, &statbuf) < 0)
+ return -1;
+
+ return (GFC_IO_INT) statbuf.st_size;
+}
static const char yes[] = "YES", no[] = "NO", unknown[] = "UNKNOWN";
inquire_sequential (const char *string, int len)
{
char path[PATH_MAX + 1];
- struct stat statbuf;
+ gfstat_t statbuf;
if (string == NULL ||
unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
if (S_ISREG (statbuf.st_mode) ||
S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
- return yes;
+ return unknown;
if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
return no;
inquire_direct (const char *string, int len)
{
char path[PATH_MAX + 1];
- struct stat statbuf;
+ gfstat_t statbuf;
if (string == NULL ||
unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
return unknown;
if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
- return yes;
+ return unknown;
if (S_ISDIR (statbuf.st_mode) ||
S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
inquire_formatted (const char *string, int len)
{
char path[PATH_MAX + 1];
- struct stat statbuf;
+ gfstat_t statbuf;
if (string == NULL ||
unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
if (S_ISREG (statbuf.st_mode) ||
S_ISBLK (statbuf.st_mode) ||
S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
- return yes;
+ return unknown;
if (S_ISDIR (statbuf.st_mode))
return no;
}
+#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. */
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)
-{
- return ((unix_stream *) s)->logical_offset;
+ gfc_offset curr, end;
+ if (!is_seekable (s))
+ return -1;
+ curr = stell (s);
+ if (curr == -1)
+ return curr;
+ end = sseek (s, 0, SEEK_END);
+ sseek (s, curr, SEEK_SET);
+ return end;
}
* it is not */
int
-is_seekable (stream * s)
+is_seekable (stream *s)
{
/* By convention, if file_length == -1, the file is not
seekable. */
return ((unix_stream *) s)->file_length!=-1;
}
-try
-flush (stream *s)
+
+/* is_special()-- Return nonzero if the stream is not a regular file. */
+
+int
+is_special (stream *s)
{
- return fd_flush( (unix_stream *) s);
+ return ((unix_stream *) s)->special_file;
}
+
int
stream_isatty (stream *s)
{
}
char *
-stream_ttyname (stream *s)
+stream_ttyname (stream *s __attribute__ ((unused)))
{
#ifdef HAVE_TTYNAME
return ttyname (((unix_stream *) s)->fd);
#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.
the solution used by f2c. Each record contains a pair of length
markers:
- Length of record n in bytes
- Data of record n
- Length of record n in bytes
+ Length of record n in bytes
+ Data of record n
+ Length of record n in bytes
- Length of record n+1 in bytes
- Data of record n+1
- Length of record n+1 in bytes
+ Length of record n+1 in bytes
+ Data of record n+1
+ Length of record n+1 in bytes
The length is stored at the end of a record to allow backspacing to the
previous record. Between data transfer statements, the file pointer