-/* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+/* 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).
+This file is part of the GNU Fortran 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, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, 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>
-#ifdef HAVE_SYS_MMAN_H
-#include <sys/mman.h>
-#endif
#include <string.h>
#include <errno.h>
-#include "libgfortran.h"
-#include "io.h"
-#ifndef PATH_MAX
-#define PATH_MAX 1024
-#endif
+/* 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));
+}
-#ifndef MAP_FAILED
-#define MAP_FAILED ((void *) -1)
#endif
-#ifndef PROT_READ
-#define PROT_READ 1
+#else
+typedef struct stat gfstat_t;
#endif
-#ifndef PROT_WRITE
-#define PROT_WRITE 2
+#ifndef PATH_MAX
+#define PATH_MAX 1024
#endif
/* These flags aren't defined on all targets (mingw32), so provide them
#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. */
-
-
-#define BUFFER_SIZE 8192
+
+#ifndef HAVE_ACCESS
+
+#ifndef W_OK
+#define W_OK 2
+#endif
+
+#ifndef R_OK
+#define R_OK 4
+#endif
+
+#ifndef F_OK
+#define F_OK 0
+#endif
+
+/* Fallback implementation of access() on systems that don't have it.
+ Only modes R_OK, W_OK and F_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;
+
+ if (mode == F_OK)
+ {
+ gfstat_t st;
+ return stat (path, &st);
+ }
+
+ return 0;
+}
+
+#undef access
+#define access fallback_access
+#endif
+
+
+/* Unix and internal stream I/O module */
+
+static const int 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 */
+ char *buffer; /* Pointer to the buffer. */
+ int fd; /* The POSIX file descriptor. */
- int prot;
- int ndirty; /* Dirty bytes starting at dirty_offset */
+ int active; /* Length of valid bytes in the buffer */
- unsigned unbuffered:1, mmaped:1;
+ int ndirty; /* Dirty bytes starting at buffer_offset */
- char small_buffer[BUFFER_SIZE];
+ int special_file; /* =1 if the fd refers to a special file */
+ /* Cached stat(2) values. */
+ dev_t st_dev;
+ ino_t st_ino;
}
unix_stream;
-/*move_pos_offset()-- Move the record pointer right or left
- *relative to current position */
-
-int
-move_pos_offset (stream* st, int pos_off)
-{
- 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;
-
- 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 ;
- }
- }
-
- return pos_off ;
- }
- return 0 ;
-}
-
/* fix_fd()-- Given a file descriptor, make sure it is not one of the
* standard descriptors, returning a non-standard descriptor. If 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;
}
-/* write()-- Write a buffer to a descriptor, allowing for short writes */
-
-static int
-writen (int fd, char *buffer, int len)
-{
- int n, n0;
-
- n0 = len;
-
- while (len > 0)
- {
- n = write (fd, buffer, len);
- if (n < 0)
- return n;
-
- buffer += n;
- len -= n;
- }
-
- return n0;
-}
-
-
-#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. */
-
-static int
-readn (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 nread, n;
-
- nread = 0;
-
- while (len > 0)
- {
- n = read (fd, buffer, len);
- if (n < 0)
- return n;
-
- if (n == 0)
- return nread;
-
- buffer += n;
- nread += n;
- len -= n;
- }
+ int fd;
- return nread;
+ 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);
}
-#endif
/* get_oserror()-- Get the most recent operating system error. For
}
-/* sys_exit()-- Terminate the program with an exit code */
-
-void
-sys_exit (int code)
-{
- exit (code);
-}
+/********************************************************************
+Raw I/O functions (read, write, seek, tell, truncate, close).
-
-/*********************************************************************
- File descriptor stream functions
+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.
*********************************************************************/
-/* fd_flush()-- Write bytes that need to be written */
-
-static try
-fd_flush (unix_stream * s)
+static int
+raw_flush (unix_stream * s __attribute__ ((unused)))
{
- if (s->ndirty == 0)
- return SUCCESS;;
+ return 0;
+}
- if (s->physical_offset != s->dirty_offset &&
- lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
- return FAILURE;
+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);
+}
- if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
- s->ndirty) < 0)
- return FAILURE;
+static ssize_t
+raw_write (unix_stream * s, const void * buf, ssize_t nbyte)
+{
+ ssize_t trans, bytes_left;
+ char *buf_st;
- s->physical_offset = s->dirty_offset + s->ndirty;
+ bytes_left = nbyte;
+ buf_st = (char *) buf;
- /* 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;
+ /* We must write in a loop since some systems don't restart system
+ calls in case of a signal. */
+ while (bytes_left > 0)
+ {
+ trans = write (s->fd, buf_st, bytes_left);
+ if (trans < 0)
+ {
+ if (errno == EINTR)
+ continue;
+ else
+ return trans;
+ }
+ buf_st += trans;
+ bytes_left -= trans;
+ }
- return SUCCESS;
+ return nbyte - bytes_left;
}
+static gfc_offset
+raw_seek (unix_stream * s, gfc_offset offset, int whence)
+{
+ return lseek (s->fd, offset, whence);
+}
-/* 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 gfc_offset
+raw_tell (unix_stream * s)
+{
+ return lseek (s->fd, 0, SEEK_CUR);
+}
-static void
-fd_alloc (unix_stream * s, gfc_offset where, int *len)
+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 = (HANDLE) _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;
}
+ 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
+}
- s->buffer_offset = where;
-
- /* free the old buffer if necessary */
+static int
+raw_close (unix_stream * s)
+{
+ int retval;
+
+ if (s->fd != STDOUT_FILENO
+ && s->fd != STDERR_FILENO
+ && s->fd != STDIN_FILENO)
+ retval = close (s->fd);
+ else
+ retval = 0;
+ free (s);
+ return retval;
+}
- if (s->buffer != NULL && s->buffer != s->small_buffer)
- free_mem (s->buffer);
+static int
+raw_init (unix_stream * s)
+{
+ 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;
- s->buffer = new_buffer;
- s->len = read_len;
- s->mmaped = 0;
+ s->buffer = NULL;
+ return 0;
}
-/* 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. */
+/*********************************************************************
+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 char *
-fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
+static int
+buf_flush (unix_stream * s)
{
- gfc_offset m;
- int n;
-
- if (where == -1)
- where = s->logical_offset;
-
- if (s->buffer != NULL && s->buffer_offset <= where &&
- where + *len <= s->buffer_offset + s->active)
- {
+ int writelen;
- /* Return a position within the current buffer */
-
- s->logical_offset = where + *len;
- return s->buffer + where - s->buffer_offset;
- }
+ /* Flushing in read mode means discarding read bytes. */
+ s->active = 0;
- fd_alloc (s, where, len);
+ 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;
- m = where + s->active;
+ writelen = raw_write (s, s->buffer, s->ndirty);
- if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
- return NULL;
+ s->physical_offset = s->buffer_offset + writelen;
- n = read (s->fd, s->buffer + s->active, s->len - s->active);
- if (n < 0)
- return NULL;
-
- s->physical_offset = where + n;
+ /* 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->active += n;
- if (s->active < *len)
- *len = s->active; /* Bytes actually available */
+ s->ndirty -= writelen;
+ if (s->ndirty != 0)
+ return -1;
- s->logical_offset = where + *len;
+#ifdef _WIN32
+ _commit (s->fd);
+#endif
- return s->buffer;
+ return 0;
}
-
-/* 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 ssize_t
+buf_read (unix_stream * s, void * buf, ssize_t nbyte)
{
- gfc_offset n;
-
- if (where == -1)
- where = s->logical_offset;
+ if (s->active == 0)
+ s->buffer_offset = s->logical_offset;
- if (s->buffer == NULL || s->buffer_offset > where ||
- where + *len > s->buffer_offset + s->len)
+ /* 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
{
-
- if (fd_flush (s) == FAILURE)
- return NULL;
- fd_alloc (s, where, len);
+ /* 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
+ {
+ did_read = raw_read (s, p, to_read);
+ s->physical_offset += did_read;
+ s->active = 0;
+ }
+ nbyte = did_read + nread;
}
+ s->logical_offset += nbyte;
+ return nbyte;
+}
- /* 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;
+static ssize_t
+buf_write (unix_stream * s, const void * buf, ssize_t nbyte)
+{
+ 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)
+ {
+ 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
- {
- 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;
+ {
+ /* 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
+ {
+ 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 = 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->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;
}
-
-static try
-fd_sfree (unix_stream * s)
+static gfc_offset
+buf_seek (unix_stream * s, gfc_offset offset, int whence)
{
- if (s->ndirty != 0 &&
- (s->buffer != s->small_buffer || options.all_unbuffered ||
- s->unbuffered))
- return fd_flush (s);
-
- return SUCCESS;
+ 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;
+ }
+ if (offset < 0)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ s->logical_offset = offset;
+ return offset;
}
-
-static int
-fd_seek (unix_stream * s, gfc_offset offset)
+static gfc_offset
+buf_tell (unix_stream * s)
{
- s->physical_offset = s->logical_offset = offset;
-
- return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
+ return s->logical_offset;
}
-
-/* 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. */
-
-static try
-fd_truncate (unix_stream * s)
+static int
+buf_truncate (unix_stream * s, gfc_offset length)
{
- if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
- return FAILURE;
+ int r;
- /* 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;
+ 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 (close (s->fd) < 0)
- return FAILURE;
-
- free_mem (s);
-
- return SUCCESS;
+ if (buf_flush (s) != 0)
+ return -1;
+ free (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->buffer = NULL;
+ 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 = get_mem (BUFFER_SIZE);
+ return 0;
}
/*********************************************************************
- mmap stream functions
+ memory stream functions - These are used for internal files
- 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.
+ The idea here is that a single stream structure is created and all
+ requests must be satisfied from it. The location and size of the
+ buffer is the character variable supplied to the READ or WRITE
+ statement.
*********************************************************************/
-#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)
+char *
+mem_alloc_r (stream * strm, int * len)
{
- if (!s->mmaped)
- return fd_flush (s);
+ unix_stream * s = (unix_stream *) strm;
+ gfc_offset n;
+ gfc_offset where = s->logical_offset;
- if (s->buffer == NULL)
- return SUCCESS;
+ if (where < s->buffer_offset || where > s->buffer_offset + s->active)
+ return NULL;
- if (munmap (s->buffer, s->active))
- return FAILURE;
+ n = s->buffer_offset + s->active - where;
+ if (*len > n)
+ *len = n;
- s->buffer = NULL;
- s->active = 0;
+ s->logical_offset = where + *len;
- return SUCCESS;
+ return s->buffer + (where - s->buffer_offset);
}
-/* 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)
+char *
+mem_alloc_r4 (stream * strm, 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 */
+ unix_stream * s = (unix_stream *) strm;
+ gfc_offset n;
+ gfc_offset where = s->logical_offset;
- length = ((where - offset) & page_mask) + 2 * page_size;
+ if (where < s->buffer_offset || where > s->buffer_offset + s->active)
+ return NULL;
- p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
- if (p == (char *) MAP_FAILED)
- return FAILURE;
+ n = s->buffer_offset + s->active - where;
+ if (*len > n)
+ *len = n;
- s->mmaped = 1;
- s->buffer = p;
- s->buffer_offset = offset;
- s->active = length;
+ s->logical_offset = where + *len;
- return SUCCESS;
+ return s->buffer + (where - s->buffer_offset) * 4;
}
-static char *
-mmap_alloc_r_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;
-
- if (where == -1)
- where = s->logical_offset;
+ gfc_offset 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)
+ if (where < s->buffer_offset)
return NULL;
if (m > s->file_length)
- {
- *len = s->file_length - s->logical_offset;
- s->logical_offset = s->file_length;
- }
- 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)
- {
- if (s->mmaped)
- mmap_flush (s);
- return fd_alloc_w_at (s, len, where);
- }
-
- if ((s->buffer == NULL || s->buffer_offset > where ||
- where + *len > s->buffer_offset + s->active ||
- where < 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;
- return SUCCESS;
-}
-
-
-static try
-mmap_close (unix_stream * s)
-{
- try t;
-
- t = mmap_flush (s);
-
- if (close (s->fd) < 0)
- t = FAILURE;
- free_mem (s);
-
- return t;
-}
-
+ s->logical_offset = m;
-static try
-mmap_sfree (unix_stream * s)
-{
- return SUCCESS;
+ return s->buffer + (where - s->buffer_offset);
}
-/* mmap_open()-- mmap_specific open. If the particular file cannot be
- * mmap()-ed, we fall back to the file descriptor functions. */
-
-static try
-mmap_open (unix_stream * s)
+gfc_char4_t *
+mem_alloc_w4 (stream * strm, int * len)
{
- char *p;
- int i;
-
- page_size = getpagesize ();
- page_mask = ~0;
-
- p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
- if (p == (char *) MAP_FAILED)
- {
- fd_open (s);
- return SUCCESS;
- }
-
- munmap (p, page_size);
-
- i = page_size >> 1;
- while (i != 0)
- {
- page_mask <<= 1;
- i >>= 1;
- }
-
- 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;
-
- if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
- return FAILURE;
-
- return SUCCESS;
-}
+ unix_stream * s = (unix_stream *) strm;
+ gfc_offset m;
+ gfc_offset where = s->logical_offset;
+ gfc_char4_t *result = (gfc_char4_t *) s->buffer;
-#endif
+ m = where + *len;
+ if (where < s->buffer_offset)
+ return NULL;
-/*********************************************************************
- memory stream functions - These are used for internal files
+ if (m > s->file_length)
+ return NULL;
- The idea here is that a single stream structure is created and all
- requests must be satisfied from it. The location and size of the
- buffer is the character variable supplied to the READ or WRITE
- statement.
+ s->logical_offset = m;
+ return &result[where - s->buffer_offset];
+}
-*********************************************************************/
+/* Stream read function for character(kine=1) internal units. */
-static char *
-mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
+static ssize_t
+mem_read (stream * s, void * buf, ssize_t nbytes)
{
- gfc_offset n;
+ void *p;
+ int nb = nbytes;
- if (where == -1)
- where = s->logical_offset;
+ p = mem_alloc_r (s, &nb);
+ if (p)
+ {
+ memcpy (buf, p, nb);
+ return (ssize_t) nb;
+ }
+ else
+ return 0;
+}
- if (where < s->buffer_offset || where > s->buffer_offset + s->active)
- return NULL;
- s->logical_offset = where + *len;
+/* Stream read function for chracter(kind=4) internal units. */
- n = s->buffer_offset + s->active - where;
- if (*len > n)
- *len = n;
+static ssize_t
+mem_read4 (stream * s, void * buf, ssize_t nbytes)
+{
+ void *p;
+ int nb = nbytes;
- return s->buffer + (where - s->buffer_offset);
+ p = mem_alloc_r (s, &nb);
+ if (p)
+ {
+ memcpy (buf, p, nb);
+ return (ssize_t) nb;
+ }
+ else
+ return 0;
}
-static char *
-mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
+/* Stream write function for character(kind=1) internal units. */
+
+static ssize_t
+mem_write (stream * s, const void * buf, ssize_t nbytes)
{
- gfc_offset m;
+ void *p;
+ int nb = nbytes;
- if (where == -1)
- where = s->logical_offset;
+ p = mem_alloc_w (s, &nb);
+ if (p)
+ {
+ memcpy (p, buf, nb);
+ return (ssize_t) nb;
+ }
+ else
+ return 0;
+}
- m = where + *len;
- if (where < s->buffer_offset || m > s->buffer_offset + s->active)
- return NULL;
+/* Stream write function for character(kind=4) internal units. */
- s->logical_offset = m;
+static ssize_t
+mem_write4 (stream * s, const void * buf, ssize_t nwords)
+{
+ gfc_char4_t *p;
+ int nw = nwords;
- return s->buffer + (where - s->buffer_offset);
+ p = mem_alloc_w4 (s, &nw);
+ if (p)
+ {
+ while (nw--)
+ *p++ = (gfc_char4_t) *((char *) buf);
+ return nwords;
+ }
+ else
+ 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 int
-mem_truncate (unix_stream * s)
+static gfc_offset
+mem_tell (stream * s)
{
- return SUCCESS;
+ return ((unix_stream *)s)->logical_offset;
}
-static try
-mem_close (unix_stream * s)
+static int
+mem_truncate (unix_stream * s __attribute__ ((unused)),
+ gfc_offset length __attribute__ ((unused)))
{
- free_mem (s);
-
- return SUCCESS;
+ return 0;
}
-static try
-mem_sfree (unix_stream * s)
+static int
+mem_flush (unix_stream * s __attribute__ ((unused)))
{
- return SUCCESS;
+ return 0;
}
+static int
+mem_close (unix_stream * s)
+{
+ if (s != NULL)
+ free (s);
+
+ return 0;
+}
+
/*********************************************************************
Public functions -- A reimplementation of this module needs to
define functional equivalents of the following.
*********************************************************************/
-/* empty_internal_buffer()-- Zero the buffer of Internal file */
+/* open_internal()-- Returns a stream structure from a character(kind=1)
+ internal file */
-void
-empty_internal_buffer(stream *strm)
+stream *
+open_internal (char *base, int length, gfc_offset offset)
{
- unix_stream * s = (unix_stream *) strm;
- memset(s->buffer, ' ', s->file_length);
+ unix_stream *s;
+
+ s = get_mem (sizeof (unix_stream));
+ memset (s, '\0', sizeof (unix_stream));
+
+ s->buffer = base;
+ s->buffer_offset = offset;
+
+ s->logical_offset = 0;
+ s->active = s->file_length = length;
+
+ s->st.close = (void *) mem_close;
+ s->st.seek = (void *) mem_seek;
+ 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.flush = (void *) mem_flush;
+
+ return (stream *) s;
}
-/* open_internal()-- Returns a stream structure from an internal file */
+/* open_internal4()-- Returns a stream structure from a character(kind=4)
+ internal file */
stream *
-open_internal (char *base, int length)
+open_internal4 (char *base, int length, gfc_offset offset)
{
unix_stream *s;
s = get_mem (sizeof (unix_stream));
+ 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_read4;
+ s->st.write = (void *) mem_write4;
+ s->st.flush = (void *) mem_flush;
return (stream *) s;
}
* around it. */
static stream *
-fd_to_stream (int fd, int prot)
+fd_to_stream (int fd)
{
- struct stat statbuf;
+ gfstat_t statbuf;
unix_stream *s;
s = get_mem (sizeof (unix_stream));
+ memset (s, '\0', sizeof (unix_stream));
s->fd = fd;
s->buffer_offset = 0;
s->physical_offset = 0;
s->logical_offset = 0;
- s->prot = prot;
/* 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
- fd_open (s);
-#endif
+ s->st_dev = statbuf.st_dev;
+ s->st_ino = statbuf.st_ino;
+ s->special_file = !S_ISREG (statbuf.st_mode);
+
+ if (S_ISREG (statbuf.st_mode))
+ s->file_length = statbuf.st_size;
+ else if (S_ISBLK (statbuf.st_mode))
+ {
+ /* Hopefully more portable than ioctl(fd, BLKGETSIZE64, &size)? */
+ gfc_offset cur = lseek (fd, 0, SEEK_CUR);
+ s->file_length = lseek (fd, 0, SEEK_END);
+ lseek (fd, cur, SEEK_SET);
+ }
+ else
+ s->file_length = -1;
+
+ if (!(S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
+ || options.all_unbuffered
+ ||(options.unbuffered_preconnected &&
+ (s->fd == STDIN_FILENO
+ || s->fd == STDOUT_FILENO
+ || s->fd == STDERR_FILENO))
+ || isatty (s->fd))
+ raw_init (s);
+ else
+ buf_init (s);
return (stream *) 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;
}
* 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)
{
+ if (fstring == NULL)
+ return 1;
len = fstrlen (fstring, len);
if (len >= PATH_MAX)
return 1;
* 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;
+ const char *slash = "/";
int fd;
tempdir = getenv ("GFORTRAN_TMPDIR");
+#ifdef __MINGW32__
+ if (tempdir == NULL)
+ {
+ char buffer[MAX_PATH + 1];
+ DWORD ret;
+ ret = GetTempPath (MAX_PATH, buffer);
+ /* If we are not able to get a temp-directory, we use
+ current directory. */
+ if (ret > MAX_PATH || !ret)
+ buffer[0] = 0;
+ else
+ buffer[ret] = 0;
+ tempdir = strdup (buffer);
+ }
+#else
if (tempdir == NULL)
tempdir = getenv ("TMP");
if (tempdir == NULL)
+ tempdir = getenv ("TEMP");
+ if (tempdir == NULL)
tempdir = DEFAULT_TEMPDIR;
+#endif
+ /* Check for special case that tempdir contains slash
+ or backslash at end. */
+ if (*tempdir == 0 || tempdir[strlen (tempdir) - 1] == '/'
+#ifdef __MINGW32__
+ || tempdir[strlen (tempdir) - 1] == '\\'
+#endif
+ )
+ slash = "";
template = get_mem (strlen (tempdir) + 20);
- st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
-
#ifdef HAVE_MKSTEMP
+ sprintf (template, "%s%sgfortrantmpXXXXXX", tempdir, slash);
fd = mkstemp (template);
#else /* HAVE_MKSTEMP */
-
- if (mktemp (template))
- do
- fd = open (template, O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
- while (!(fd == -1 && errno == EEXIST) && mktemp (template));
- else
- fd = -1;
-
+ fd = -1;
+ do
+ {
+ sprintf (template, "%s%sgfortrantmpXXXXXX", tempdir, slash);
+ 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);
+#else
+ fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
+#endif
+ }
+ while (fd == -1 && errno == EEXIST);
#endif /* HAVE_MKSTEMP */
if (fd < 0)
- free_mem (template);
+ free (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;
}
+#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;
default:
- internal_error ("regular_file(): Bad action");
+ internal_error (&opp->common, "regular_file(): Bad action");
}
switch (flags->status)
break;
case STATUS_REPLACE:
- crflag = 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");
}
/* 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;
+ 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 */
}
* Returns NULL on operating system error. */
stream *
-open_external (unit_flags *flags)
+open_external (st_parameter_open *opp, unit_flags *flags)
{
- int fd, prot;
+ int fd;
if (flags->status == STATUS_SCRATCH)
{
- fd = tempfile ();
+ 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. */
- 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)
return NULL;
fd = fix_fd (fd);
- switch (flags->action)
- {
- case ACTION_READ:
- prot = PROT_READ;
- break;
-
- case ACTION_WRITE:
- prot = PROT_WRITE;
- break;
-
- case ACTION_READWRITE:
- prot = PROT_READ | PROT_WRITE;
- break;
-
- default:
- internal_error ("open_external(): Bad action");
- }
-
- return fd_to_stream (fd, prot);
+ return fd_to_stream (fd);
}
stream *
input_stream (void)
{
- return fd_to_stream (STDIN_FILENO, PROT_READ);
+ return fd_to_stream (STDIN_FILENO);
}
-/* 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)
{
- return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
+ stream * s;
+
+#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
+ setmode (STDOUT_FILENO, O_BINARY);
+#endif
+
+ s = fd_to_stream (STDOUT_FILENO);
+ 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. */
+/* error_stream()-- Return a stream pointer to the default error stream.
+ * Called on initialization. */
stream *
-init_error_stream (void)
+error_stream (void)
+{
+ stream * s;
+
+#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
+ setmode (STDERR_FILENO, O_BINARY);
+#endif
+
+ s = fd_to_stream (STDERR_FILENO);
+ return s;
+}
+
+
+/* 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;
+ gfstat_t st;
+#ifdef HAVE_WORKING_STAT
+ unix_stream *s;
+#else
+# ifdef __MINGW32__
+ uint64_t id1, id2;
+# endif
+#endif
if (unpack_filename (path, name, len))
return 0; /* Can't be the same */
/* If the filename doesn't exist, then there is no match with the
* existing file. */
- if (stat (path, &st1) < 0)
+ if (stat (path, &st) < 0)
return 0;
- fstat (((unix_stream *) s)->fd, &st2);
+#ifdef HAVE_WORKING_STAT
+ s = (unix_stream *) (u->s);
+ return (st.st_dev == s->st_dev) && (st.st_ino == s->st_ino);
+#else
- return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
+# 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);
+#endif
}
+#ifdef HAVE_WORKING_STAT
+# define FIND_FILE0_DECL gfstat_t *st
+# define FIND_FILE0_ARGS st
+#else
+# 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() */
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 defined(__MINGW32__) && !HAVE_WORKING_STAT
+ uint64_t id1;
+#endif
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)
- return u;
+#ifdef HAVE_WORKING_STAT
+ if (u->s != NULL)
+ {
+ unix_stream *s = (unix_stream *) (u->s);
+ if (st[0].st_dev == s->st_dev && st[0].st_ino == s->st_ino)
+ return u;
+ }
+#else
+# 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, 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;
+ gfstat_t st[1];
+ gfc_unit *u;
+#if defined(__MINGW32__) && !HAVE_WORKING_STAT
+ uint64_t id = 0ULL;
+#endif
- 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);
-}
-
+#if defined(__MINGW32__) && !HAVE_WORKING_STAT
+ id = id_from_path (path);
+#endif
-/* stream_at_bof()-- Returns nonzero if the stream is at the beginning
- * of the file. */
+ __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 (u);
+ goto retry;
+ }
+
+ dec_waiting_unlocked (u);
+ }
+ return u;
+}
-int
-stream_at_bof (stream * s)
+static gfc_unit *
+flush_all_units_1 (gfc_unit *u, int min_unit)
{
- unix_stream *us;
-
- us = (unix_stream *) s;
-
- if (!us->mmaped)
- return 0; /* File is not seekable */
-
- return us->logical_offset == 0;
+ 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)
+ sflush (u->s);
+ __gthread_mutex_unlock (&u->lock);
+ }
+ u = u->right;
+ }
+ return NULL;
}
-
-/* stream_at_eof()-- Returns nonzero if the stream is at the beginning
- * of the file. */
-
-int
-stream_at_eof (stream * s)
+void
+flush_all_units (void)
{
- unix_stream *us;
+ gfc_unit *u;
+ int min_unit = 0;
- us = (unix_stream *) s;
-
- if (!us->mmaped)
- return 0; /* File is not seekable */
-
- return us->logical_offset == us->dirty_offset;
+ __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)
+ {
+ sflush (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 (u);
+ }
+ }
+ while (1);
}
* 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)
- return 0;
-
- return 1;
+ return !(access (path, F_OK));
}
+/* 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";
+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
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;
gfc_offset
file_length (stream * s)
{
- return ((unix_stream *) s)->file_length;
+ 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;
}
-/* file_position()-- Return the current position of the file */
+/* is_seekable()-- Return nonzero if the stream is seekable, zero if
+ * it is not */
-gfc_offset
-file_position (stream * s)
+int
+is_seekable (stream *s)
{
- return ((unix_stream *) s)->logical_offset;
+ /* By convention, if file_length == -1, the file is not
+ seekable. */
+ return ((unix_stream *) s)->file_length!=-1;
}
-/* is_seekable()-- Return nonzero if the stream is seekable, zero if
- * it is not */
+/* is_special()-- Return nonzero if the stream is not a regular file. */
int
-is_seekable (stream * s)
+is_special (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. */
- return ((unix_stream *) s)->file_length!=-1;
+ return ((unix_stream *) s)->special_file;
+}
+
+
+int
+stream_isatty (stream *s)
+{
+ return isatty (((unix_stream *) s)->fd);
}
-try
-flush (stream *s)
+char *
+#ifdef HAVE_TTYNAME
+stream_ttyname (stream *s)
+{
+ return ttyname (((unix_stream *) s)->fd);
+}
+#else
+stream_ttyname (stream *s __attribute__ ((unused)))
{
- return fd_flush( (unix_stream *) s);
+ return NULL;
}
+#endif
+
/* How files are stored: This is an operating-system specific issue,
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
OSDN Git Service
