-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
- Free Software Foundation, Inc.
+/* Copyright (C) 2002-2020 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
/* Unix stream I/O module */
#include "io.h"
-#include <stdlib.h>
+#include "unix.h"
+#include "async.h"
#include <limits.h>
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
+#endif
+
#include <sys/stat.h>
#include <fcntl.h>
-#include <assert.h>
#include <string.h>
#include <errno.h>
/* For mingw, we don't identify files by their inode number, but by a
64-bit identifier created from a BY_HANDLE_FILE_INFORMATION. */
-#if defined(__MINGW32__) && !HAVE_WORKING_STAT
+#ifdef __MINGW32__
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
+#if !defined(_FILE_OFFSET_BITS) || _FILE_OFFSET_BITS != 64
+#undef lseek
+#define lseek _lseeki64
+#undef fstat
+#define fstat _fstati64
+#undef stat
+#define stat _stati64
+#endif
+
+#ifndef HAVE_WORKING_STAT
static uint64_t
id_from_handle (HANDLE hFile)
{
return id_from_handle ((HANDLE) _get_osfhandle (fd));
}
-#endif
+#endif /* HAVE_WORKING_STAT */
-#ifndef PATH_MAX
-#define PATH_MAX 1024
-#endif
-#ifndef PROT_READ
-#define PROT_READ 1
-#endif
+/* On mingw, we don't use umask in tempfile_open(), because it
+ doesn't support the user/group/other-based permissions. */
+#undef HAVE_UMASK
+
+#endif /* __MINGW32__ */
-#ifndef PROT_WRITE
-#define PROT_WRITE 2
-#endif
/* These flags aren't defined on all targets (mingw32), so provide them
here. */
#endif
+#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)
+{
+ int fd;
+
+ if (mode & R_OK)
+ {
+ if ((fd = open (path, O_RDONLY)) < 0)
+ return -1;
+ else
+ close (fd);
+ }
+
+ if (mode & W_OK)
+ {
+ if ((fd = open (path, O_WRONLY)) < 0)
+ return -1;
+ else
+ close (fd);
+ }
+
+ if (mode == F_OK)
+ {
+ struct stat st;
+ return stat (path, &st);
+ }
+
+ return 0;
+}
+
+#undef access
+#define access fallback_access
+#endif
+
+
+/* Fallback directory for creating temporary files. P_tmpdir is
+ defined on many POSIX platforms. */
+#ifndef P_tmpdir
+#ifdef _P_tmpdir
+#define P_tmpdir _P_tmpdir /* MinGW */
+#else
+#define P_tmpdir "/tmp"
+#endif
+#endif
+
+
/* Unix and internal stream I/O module */
-static const int BUFFER_SIZE = 8192;
+static const int FORMATTED_BUFFER_SIZE_DEFAULT = 8192;
+static const int UNFORMATTED_BUFFER_SIZE_DEFAULT = 128*1024;
typedef struct
{
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. */
+ gfc_offset file_length; /* Length of the file. */
char *buffer; /* Pointer to the buffer. */
+ ssize_t buffer_size; /* Length of 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 */
+ /* Cached stat(2) values. */
+ dev_t st_dev;
+ ino_t st_ino;
+
+ bool unbuffered; /* Buffer should be flushed after each I/O statement. */
}
unix_stream;
/* fix_fd()-- Given a file descriptor, make sure it is not one of the
- * standard descriptors, returning a non-standard descriptor. If the
- * user specifies that system errors should go to standard output,
- * then closes standard output, we don't want the system errors to a
- * file that has been given file descriptor 1 or 0. We want to send
- * the error to the invalid descriptor. */
+ standard descriptors, returning a non-standard descriptor. If the
+ user specifies that system errors should go to standard output,
+ then closes standard output, we don't want the system errors to a
+ file that has been given file descriptor 1 or 0. We want to send
+ the error to the invalid descriptor. */
static int
fix_fd (int fd)
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)
+flush_if_preconnected (stream *s)
{
int fd;
}
-/* get_oserror()-- Get the most recent operating system error. For
- * unix, this is errno. */
-
-const char *
-get_oserror (void)
-{
- return strerror (errno);
-}
-
-
/********************************************************************
Raw I/O functions (read, write, seek, tell, truncate, close).
*********************************************************************/
static int
-raw_flush (unix_stream * s __attribute__ ((unused)))
+raw_flush (unix_stream *s __attribute__ ((unused)))
{
return 0;
}
+/* Write/read at most 2 GB - 4k chunks at a time. Linux never reads or
+ writes more than this, and there are reports that macOS fails for
+ larger than 2 GB as well. */
+#define MAX_CHUNK 2147479552
+
static ssize_t
-raw_read (unix_stream * s, void * buf, ssize_t nbyte)
+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);
+ that will break applications that wait for interactive I/O. We
+ still can loop around EINTR, though. This however causes a
+ problem for large reads which must be chunked, see comment above.
+ So assume that if the size is larger than the chunk size, we're
+ reading from a file and not the terminal. */
+ if (nbyte <= MAX_CHUNK)
+ {
+ while (true)
+ {
+ ssize_t trans = read (s->fd, buf, nbyte);
+ if (trans == -1 && errno == EINTR)
+ continue;
+ return trans;
+ }
+ }
+ else
+ {
+ ssize_t bytes_left = nbyte;
+ char *buf_st = buf;
+ while (bytes_left > 0)
+ {
+ ssize_t to_read = bytes_left < MAX_CHUNK ? bytes_left: MAX_CHUNK;
+ ssize_t trans = read (s->fd, buf_st, to_read);
+ if (trans == -1)
+ {
+ if (errno == EINTR)
+ continue;
+ else
+ return trans;
+ }
+ buf_st += trans;
+ bytes_left -= trans;
+ }
+ return nbyte - bytes_left;
+ }
}
static ssize_t
-raw_write (unix_stream * s, const void * buf, ssize_t nbyte)
+raw_write (unix_stream *s, const void *buf, ssize_t nbyte)
{
ssize_t trans, bytes_left;
char *buf_st;
buf_st = (char *) buf;
/* We must write in a loop since some systems don't restart system
- calls in case of a signal. */
+ calls in case of a signal. Also some systems might fail outright
+ if we try to write more than 2 GB in a single syscall, so chunk
+ up large writes. */
while (bytes_left > 0)
{
- trans = write (s->fd, buf_st, bytes_left);
- if (trans < 0)
+ ssize_t to_write = bytes_left < MAX_CHUNK ? bytes_left: MAX_CHUNK;
+ trans = write (s->fd, buf_st, to_write);
+ if (trans == -1)
{
if (errno == EINTR)
continue;
return nbyte - bytes_left;
}
-static off_t
-raw_seek (unix_stream * s, off_t offset, int whence)
+static gfc_offset
+raw_seek (unix_stream *s, gfc_offset offset, int whence)
{
- return lseek (s->fd, offset, whence);
+ while (true)
+ {
+ gfc_offset off = lseek (s->fd, offset, whence);
+ if (off == (gfc_offset) -1 && errno == EINTR)
+ continue;
+ return off;
+ }
}
-static off_t
-raw_tell (unix_stream * s)
+static gfc_offset
+raw_tell (unix_stream *s)
{
- return lseek (s->fd, 0, SEEK_CUR);
+ while (true)
+ {
+ gfc_offset off = lseek (s->fd, 0, SEEK_CUR);
+ if (off == (gfc_offset) -1 && errno == EINTR)
+ continue;
+ return off;
+ }
+}
+
+static gfc_offset
+raw_size (unix_stream *s)
+{
+ struct stat statbuf;
+ if (TEMP_FAILURE_RETRY (fstat (s->fd, &statbuf)) == -1)
+ return -1;
+ if (S_ISREG (statbuf.st_mode))
+ return statbuf.st_size;
+ else
+ return 0;
}
static int
-raw_truncate (unix_stream * s, off_t length)
+raw_truncate (unix_stream *s, gfc_offset length)
{
-#ifdef HAVE_FTRUNCATE
- return ftruncate (s->fd, length);
+#ifdef __MINGW32__
+ HANDLE h;
+ gfc_offset cur;
+
+ if (isatty (s->fd))
+ {
+ errno = EBADF;
+ return -1;
+ }
+ h = (HANDLE) _get_osfhandle (s->fd);
+ if (h == INVALID_HANDLE_VALUE)
+ {
+ errno = EBADF;
+ return -1;
+ }
+ 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))
+ {
+ 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
+ if (TEMP_FAILURE_RETRY (ftruncate (s->fd, length)) == -1)
+ return -1;
+ return 0;
#elif defined HAVE_CHSIZE
return chsize (s->fd, length);
#else
}
static int
-raw_close (unix_stream * s)
+raw_close (unix_stream *s)
{
int retval;
- if (s->fd != STDOUT_FILENO
+ if (s->fd == -1)
+ retval = -1;
+ else if (s->fd != STDOUT_FILENO
&& s->fd != STDERR_FILENO
&& s->fd != STDIN_FILENO)
- retval = close (s->fd);
+ {
+ retval = close (s->fd);
+ /* close() and EINTR is special, as the file descriptor is
+ deallocated before doing anything that might cause the
+ operation to be interrupted. Thus if we get EINTR the best we
+ can do is ignore it and continue (otherwise if we try again
+ the file descriptor may have been allocated again to some
+ other file). */
+ if (retval == -1 && errno == EINTR)
+ retval = errno = 0;
+ }
else
retval = 0;
- free_mem (s);
+ free (s);
return retval;
}
static int
-raw_init (unix_stream * s)
+raw_markeor (unix_stream *s __attribute__ ((unused)))
+{
+ return 0;
+}
+
+static const struct stream_vtable raw_vtable = {
+ .read = (void *) raw_read,
+ .write = (void *) raw_write,
+ .seek = (void *) raw_seek,
+ .tell = (void *) raw_tell,
+ .size = (void *) raw_size,
+ .trunc = (void *) raw_truncate,
+ .close = (void *) raw_close,
+ .flush = (void *) raw_flush,
+ .markeor = (void *) raw_markeor
+};
+
+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->st.vptr = &raw_vtable;
s->buffer = NULL;
return 0;
*********************************************************************/
static int
-buf_flush (unix_stream * s)
+buf_flush (unix_stream *s)
{
int writelen;
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)
+ if (s->physical_offset != s->buffer_offset
+ && raw_seek (s, s->buffer_offset, SEEK_SET) < 0)
return -1;
writelen = raw_write (s, s->buffer, s->ndirty);
s->physical_offset = s->buffer_offset + writelen;
- /* Don't increment file_length if the file is non-seekable. */
- if (s->file_length != -1 && s->physical_offset > s->file_length)
+ if (s->physical_offset > s->file_length)
s->file_length = s->physical_offset;
s->ndirty -= writelen;
}
static ssize_t
-buf_read (unix_stream * s, void * buf, ssize_t nbyte)
+buf_read (unix_stream *s, void *buf, ssize_t nbyte)
{
if (s->active == 0)
s->buffer_offset = s->logical_offset;
/* 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);
+ {
+ /* When nbyte == 0, buf can be NULL which would lead to undefined
+ behavior if we called memcpy(). */
+ if (nbyte != 0)
+ memcpy (buf, s->buffer + (s->logical_offset - s->buffer_offset),
+ nbyte);
+ }
else
{
/* First copy the active bytes if applicable, then read the rest
/* 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)
+ if (s->physical_offset != new_logical
+ && raw_seek (s, new_logical, SEEK_SET) < 0)
return -1;
s->buffer_offset = s->physical_offset = new_logical;
- if (to_read <= BUFFER_SIZE/2)
+ if (to_read <= s->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);
+ did_read = raw_read (s, s->buffer, s->buffer_size);
+ if (likely (did_read >= 0))
+ {
+ 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 did_read;
}
else
{
did_read = raw_read (s, p, to_read);
- s->physical_offset += did_read;
- s->active = 0;
+ if (likely (did_read >= 0))
+ {
+ s->physical_offset += did_read;
+ s->active = 0;
+ }
+ else
+ return did_read;
}
nbyte = did_read + nread;
}
}
static ssize_t
-buf_write (unix_stream * s, const void * buf, ssize_t nbyte)
+buf_write (unix_stream *s, const void *buf, ssize_t nbyte)
{
+ if (nbyte == 0)
+ return 0;
+
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,
+ buffer is empty and the request is bigger than s->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
+ if (!(s->ndirty == 0 && nbyte > s->buffer_size/2)
+ && s->logical_offset + nbyte <= s->buffer_offset + s->buffer_size
&& s->buffer_offset <= s->logical_offset
&& s->buffer_offset + s->ndirty >= s->logical_offset)
{
the request is bigger than the buffer size, write directly
bypassing the buffer. */
buf_flush (s);
- if (nbyte <= BUFFER_SIZE/2)
+ if (nbyte <= s->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
- && lseek (s->fd, s->logical_offset, SEEK_SET) < 0)
- return -1;
- nbyte = raw_write (s, buf, nbyte);
- s->physical_offset += nbyte;
- }
+ {
+ if (s->physical_offset != s->logical_offset)
+ {
+ if (raw_seek (s, 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)
+ if (s->logical_offset > s->file_length)
s->file_length = s->logical_offset;
return nbyte;
}
-static off_t
-buf_seek (unix_stream * s, off_t offset, int whence)
+
+/* "Unbuffered" really means I/O statement buffering. For formatted
+ I/O, the fbuf manages this, and then uses raw I/O. For unformatted
+ I/O, buffered I/O is used, and the buffer is flushed at the end of
+ each I/O statement, where this function is called. Alternatively,
+ the buffer is flushed at the end of the record if the buffer is
+ more than half full; this prevents needless seeking back and forth
+ when writing sequential unformatted. */
+
+static int
+buf_markeor (unix_stream *s)
+{
+ if (s->unbuffered || s->ndirty >= s->buffer_size / 2)
+ return buf_flush (s);
+ return 0;
+}
+
+static gfc_offset
+buf_seek (unix_stream *s, gfc_offset offset, int whence)
{
switch (whence)
{
return offset;
}
-static off_t
-buf_tell (unix_stream * s)
+static gfc_offset
+buf_tell (unix_stream *s)
{
- return s->logical_offset;
+ return buf_seek (s, 0, SEEK_CUR);
+}
+
+static gfc_offset
+buf_size (unix_stream *s)
+{
+ return s->file_length;
}
static int
-buf_truncate (unix_stream * s, off_t length)
+buf_truncate (unix_stream *s, gfc_offset length)
{
int r;
}
static int
-buf_close (unix_stream * s)
+buf_close (unix_stream *s)
{
if (buf_flush (s) != 0)
return -1;
- free_mem (s->buffer);
+ free (s->buffer);
return raw_close (s);
}
+static const struct stream_vtable buf_vtable = {
+ .read = (void *) buf_read,
+ .write = (void *) buf_write,
+ .seek = (void *) buf_seek,
+ .tell = (void *) buf_tell,
+ .size = (void *) buf_size,
+ .trunc = (void *) buf_truncate,
+ .close = (void *) buf_close,
+ .flush = (void *) buf_flush,
+ .markeor = (void *) buf_markeor
+};
+
static int
-buf_init (unix_stream * s)
+buf_init (unix_stream *s, bool unformatted)
{
- 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->st.vptr = &buf_vtable;
+
+ /* Try to guess a good value for the buffer size. For formatted
+ I/O, we use so many CPU cycles converting the data that there is
+ more sense in converving memory and especially cache. For
+ unformatted, a bigger block can have a large impact in some
+ environments. */
- s->buffer = get_mem (BUFFER_SIZE);
+ if (unformatted)
+ {
+ if (options.unformatted_buffer_size > 0)
+ s->buffer_size = options.unformatted_buffer_size;
+ else
+ s->buffer_size = UNFORMATTED_BUFFER_SIZE_DEFAULT;
+ }
+ else
+ {
+ if (options.formatted_buffer_size > 0)
+ s->buffer_size = options.formatted_buffer_size;
+ else
+ s->buffer_size = FORMATTED_BUFFER_SIZE_DEFAULT;
+ }
+
+ s->buffer = xmalloc (s->buffer_size);
return 0;
}
*********************************************************************/
-
char *
-mem_alloc_r (stream * strm, int * len)
+mem_alloc_r (stream *strm, size_t *len)
{
- unix_stream * s = (unix_stream *) strm;
+ unix_stream *s = (unix_stream *) strm;
gfc_offset n;
gfc_offset where = s->logical_offset;
return NULL;
n = s->buffer_offset + s->active - where;
- if (*len > n)
+ if ((gfc_offset) *len > n)
*len = n;
s->logical_offset = where + *len;
char *
-mem_alloc_w (stream * strm, int * len)
+mem_alloc_r4 (stream *strm, size_t *len)
{
- unix_stream * s = (unix_stream *) strm;
+ unix_stream *s = (unix_stream *) strm;
+ gfc_offset n;
+ gfc_offset where = s->logical_offset;
+
+ if (where < s->buffer_offset || where > s->buffer_offset + s->active)
+ return NULL;
+
+ n = s->buffer_offset + s->active - where;
+ if ((gfc_offset) *len > n)
+ *len = n;
+
+ s->logical_offset = where + *len;
+
+ return s->buffer + (where - s->buffer_offset) * 4;
+}
+
+
+char *
+mem_alloc_w (stream *strm, size_t *len)
+{
+ unix_stream *s = (unix_stream *)strm;
gfc_offset m;
gfc_offset where = s->logical_offset;
}
-/* Stream read function for internal units. */
+gfc_char4_t *
+mem_alloc_w4 (stream *strm, size_t *len)
+{
+ unix_stream *s = (unix_stream *)strm;
+ gfc_offset m;
+ gfc_offset where = s->logical_offset;
+ gfc_char4_t *result = (gfc_char4_t *) s->buffer;
+
+ m = where + *len;
+
+ if (where < s->buffer_offset)
+ return NULL;
+
+ if (m > s->file_length)
+ return NULL;
+
+ s->logical_offset = m;
+ return &result[where - s->buffer_offset];
+}
+
+
+/* Stream read function for character(kind=1) internal units. */
static ssize_t
-mem_read (stream * s, void * buf, ssize_t nbytes)
+mem_read (stream *s, void *buf, ssize_t nbytes)
{
void *p;
- int nb = nbytes;
+ size_t nb = nbytes;
p = mem_alloc_r (s, &nb);
if (p)
}
-/* Stream write function for internal units. This is not actually used
- at the moment, as all internal IO is formatted and the formatted IO
- routines use mem_alloc_w_at. */
+/* Stream read function for chracter(kind=4) internal units. */
+
+static ssize_t
+mem_read4 (stream *s, void *buf, ssize_t nbytes)
+{
+ void *p;
+ size_t nb = nbytes;
+
+ p = mem_alloc_r4 (s, &nb);
+ if (p)
+ {
+ memcpy (buf, p, nb * 4);
+ return (ssize_t) nb;
+ }
+ else
+ return 0;
+}
+
+
+/* Stream write function for character(kind=1) internal units. */
static ssize_t
-mem_write (stream * s, const void * buf, ssize_t nbytes)
+mem_write (stream *s, const void *buf, ssize_t nbytes)
{
void *p;
- int nb = nbytes;
+ size_t nb = nbytes;
p = mem_alloc_w (s, &nb);
if (p)
}
-static off_t
-mem_seek (stream * strm, off_t offset, int whence)
+/* Stream write function for character(kind=4) internal units. */
+
+static ssize_t
+mem_write4 (stream *s, const void *buf, ssize_t nwords)
{
- unix_stream * s = (unix_stream *) strm;
+ gfc_char4_t *p;
+ size_t nw = nwords;
+
+ p = mem_alloc_w4 (s, &nw);
+ if (p)
+ {
+ while (nw--)
+ *p++ = (gfc_char4_t) *((char *) buf);
+ return nwords;
+ }
+ else
+ return 0;
+}
+
+
+static gfc_offset
+mem_seek (stream *strm, gfc_offset offset, int whence)
+{
+ unix_stream *s = (unix_stream *)strm;
switch (whence)
{
case SEEK_SET:
}
-static off_t
-mem_tell (stream * s)
+static gfc_offset
+mem_tell (stream *s)
{
return ((unix_stream *)s)->logical_offset;
}
static int
-mem_truncate (unix_stream * s __attribute__ ((unused)),
- off_t length __attribute__ ((unused)))
+mem_truncate (unix_stream *s __attribute__ ((unused)),
+ gfc_offset length __attribute__ ((unused)))
{
return 0;
}
static int
-mem_flush (unix_stream * s __attribute__ ((unused)))
+mem_flush (unix_stream *s __attribute__ ((unused)))
{
return 0;
}
static int
-mem_close (unix_stream * s)
+mem_close (unix_stream *s)
{
- if (s != NULL)
- free_mem (s);
-
+ if (s)
+ free (s);
return 0;
}
+static const struct stream_vtable mem_vtable = {
+ .read = (void *) mem_read,
+ .write = (void *) mem_write,
+ .seek = (void *) mem_seek,
+ .tell = (void *) mem_tell,
+ /* buf_size is not a typo, we just reuse an identical
+ implementation. */
+ .size = (void *) buf_size,
+ .trunc = (void *) mem_truncate,
+ .close = (void *) mem_close,
+ .flush = (void *) mem_flush,
+ .markeor = (void *) raw_markeor
+};
+
+static const struct stream_vtable mem4_vtable = {
+ .read = (void *) mem_read4,
+ .write = (void *) mem_write4,
+ .seek = (void *) mem_seek,
+ .tell = (void *) mem_tell,
+ /* buf_size is not a typo, we just reuse an identical
+ implementation. */
+ .size = (void *) buf_size,
+ .trunc = (void *) mem_truncate,
+ .close = (void *) mem_close,
+ .flush = (void *) mem_flush,
+ .markeor = (void *) raw_markeor
+};
/*********************************************************************
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, size_t length, gfc_offset offset)
{
- unix_stream * s = (unix_stream *) strm;
- memset(s->buffer, ' ', s->file_length);
+ unix_stream *s;
+
+ s = xcalloc (1, sizeof (unix_stream));
+
+ s->buffer = base;
+ s->buffer_offset = offset;
+
+ s->active = s->file_length = length;
+
+ s->st.vptr = &mem_vtable;
+
+ 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, gfc_offset offset)
+open_internal4 (char *base, size_t length, gfc_offset offset)
{
unix_stream *s;
- s = get_mem (sizeof (unix_stream));
- memset (s, '\0', sizeof (unix_stream));
+ s = xcalloc (1, sizeof (unix_stream));
s->buffer = base;
s->buffer_offset = offset;
- s->logical_offset = 0;
- s->active = s->file_length = length;
+ s->active = s->file_length = length * sizeof (gfc_char4_t);
- 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;
+ s->st.vptr = &mem4_vtable;
- return (stream *) s;
+ return (stream *)s;
}
/* fd_to_stream()-- Given an open file descriptor, build a stream
- * around it. */
+ around it. */
static stream *
-fd_to_stream (int fd, int prot)
+fd_to_stream (int fd, bool unformatted)
{
struct stat statbuf;
unix_stream *s;
- s = get_mem (sizeof (unix_stream));
- memset (s, '\0', sizeof (unix_stream));
+ s = xcalloc (1, 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);
-
- if (lseek (fd, 0, SEEK_CUR) == (off_t) -1)
- s->file_length = -1;
- else
- s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
-
- s->special_file = !S_ISREG (statbuf.st_mode);
+ if (TEMP_FAILURE_RETRY (fstat (fd, &statbuf)) == -1)
+ {
+ s->st_dev = s->st_ino = -1;
+ s->file_length = 0;
+ if (errno == EBADF)
+ s->fd = -1;
+ raw_init (s);
+ return (stream *) 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);
+ s->st_dev = statbuf.st_dev;
+ s->st_ino = statbuf.st_ino;
+ s->file_length = statbuf.st_size;
+
+ /* Only use buffered IO for regular files. */
+ if (S_ISREG (statbuf.st_mode)
+ && !options.all_unbuffered
+ && !(options.unbuffered_preconnected &&
+ (s->fd == STDIN_FILENO
+ || s->fd == STDOUT_FILENO
+ || s->fd == STDERR_FILENO)))
+ buf_init (s, unformatted);
else
- buf_init (s);
+ {
+ if (unformatted)
+ {
+ s->unbuffered = true;
+ buf_init (s, unformatted);
+ }
+ else
+ raw_init (s);
+ }
return (stream *) s;
}
}
-/* unpack_filename()-- Given a fortran string and a pointer to a
- * buffer that is PATH_MAX characters, convert the fortran string to a
- * C string in the buffer. Returns nonzero if this is not possible. */
+/* Set the close-on-exec flag for an existing fd, if the system
+ supports such. */
-int
-unpack_filename (char *cstring, const char *fstring, int len)
+static void __attribute__ ((unused))
+set_close_on_exec (int fd __attribute__ ((unused)))
{
- len = fstrlen (fstring, len);
- if (len >= PATH_MAX)
- return 1;
-
- memmove (cstring, fstring, len);
- cstring[len] = '\0';
-
- return 0;
+ /* Mingw does not define F_SETFD. */
+#if defined(HAVE_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+ if (fd >= 0)
+ fcntl(fd, F_SETFD, FD_CLOEXEC);
+#endif
}
-/* tempfile()-- Generate a temporary filename for a scratch file and
- * open it. mkstemp() opens the file for reading and writing, but the
- * library mode prevents anything that is not allowed. The descriptor
- * is returned, which is -1 on error. The template is pointed to by
- * opp->file, which is copied into the unit structure
- * and freed later. */
+/* Helper function for tempfile(). Tries to open a temporary file in
+ the directory specified by tempdir. If successful, the file name is
+ stored in fname and the descriptor returned. Returns -1 on
+ failure. */
static int
-tempfile (st_parameter_open *opp)
+tempfile_open (const char *tempdir, char **fname)
{
- const char *tempdir;
- char *template;
int fd;
+ const char *slash = "/";
+#if defined(HAVE_UMASK) && defined(HAVE_MKSTEMP)
+ mode_t mode_mask;
+#endif
- tempdir = getenv ("GFORTRAN_TMPDIR");
- if (tempdir == NULL)
- tempdir = getenv ("TMP");
- if (tempdir == NULL)
- tempdir = getenv ("TEMP");
- if (tempdir == NULL)
- tempdir = DEFAULT_TEMPDIR;
+ if (!tempdir)
+ return -1;
- template = get_mem (strlen (tempdir) + 20);
+ /* Check for the special case that tempdir ends with a slash or
+ backslash. */
+ size_t tempdirlen = strlen (tempdir);
+ if (*tempdir == 0 || tempdir[tempdirlen - 1] == '/'
+#ifdef __MINGW32__
+ || tempdir[tempdirlen - 1] == '\\'
+#endif
+ )
+ slash = "";
- sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
+ /* Take care that the template is longer in the mktemp() branch. */
+ char *template = xmalloc (tempdirlen + 23);
#ifdef HAVE_MKSTEMP
+ snprintf (template, tempdirlen + 23, "%s%sgfortrantmpXXXXXX",
+ tempdir, slash);
- fd = mkstemp (template);
+#ifdef HAVE_UMASK
+ /* Temporarily set the umask such that the file has 0600 permissions. */
+ mode_mask = umask (S_IXUSR | S_IRWXG | S_IRWXO);
+#endif
-#else /* HAVE_MKSTEMP */
+#if defined(HAVE_MKOSTEMP) && defined(O_CLOEXEC)
+ TEMP_FAILURE_RETRY (fd = mkostemp (template, O_CLOEXEC));
+#else
+ TEMP_FAILURE_RETRY (fd = mkstemp (template));
+ set_close_on_exec (fd);
+#endif
+
+#ifdef HAVE_UMASK
+ (void) umask (mode_mask);
+#endif
- if (mktemp (template))
- do
+#else /* HAVE_MKSTEMP */
+ fd = -1;
+ int count = 0;
+ size_t slashlen = strlen (slash);
+ int flags = O_RDWR | O_CREAT | O_EXCL;
#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);
+ flags |= O_BINARY;
#endif
- while (!(fd == -1 && errno == EEXIST) && mktemp (template));
- else
- fd = -1;
+#ifdef O_CLOEXEC
+ flags |= O_CLOEXEC;
+#endif
+ do
+ {
+ snprintf (template, tempdirlen + 23, "%s%sgfortrantmpaaaXXXXXX",
+ tempdir, slash);
+ if (count > 0)
+ {
+ int c = count;
+ template[tempdirlen + slashlen + 13] = 'a' + (c% 26);
+ c /= 26;
+ template[tempdirlen + slashlen + 12] = 'a' + (c % 26);
+ c /= 26;
+ template[tempdirlen + slashlen + 11] = 'a' + (c % 26);
+ if (c >= 26)
+ break;
+ }
+
+ if (!mktemp (template))
+ {
+ errno = EEXIST;
+ count++;
+ continue;
+ }
+ TEMP_FAILURE_RETRY (fd = open (template, flags, S_IRUSR | S_IWUSR));
+ }
+ while (fd == -1 && errno == EEXIST);
+#ifndef O_CLOEXEC
+ set_close_on_exec (fd);
+#endif
#endif /* HAVE_MKSTEMP */
- if (fd < 0)
- free_mem (template);
- else
+ *fname = template;
+ return fd;
+}
+
+
+/* tempfile()-- Generate a temporary filename for a scratch file and
+ open it. mkstemp() opens the file for reading and writing, but the
+ library mode prevents anything that is not allowed. The descriptor
+ is returned, which is -1 on error. The template is pointed to by
+ opp->file, which is copied into the unit structure
+ and freed later. */
+
+static int
+tempfile (st_parameter_open *opp)
+{
+ const char *tempdir;
+ char *fname;
+ int fd = -1;
+
+ tempdir = secure_getenv ("TMPDIR");
+ fd = tempfile_open (tempdir, &fname);
+#ifdef __MINGW32__
+ if (fd == -1)
+ {
+ 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);
+ fd = tempfile_open (tempdir, &fname);
+ }
+#elif defined(__CYGWIN__)
+ if (fd == -1)
+ {
+ tempdir = secure_getenv ("TMP");
+ fd = tempfile_open (tempdir, &fname);
+ }
+ if (fd == -1)
{
- opp->file = template;
- opp->file_len = strlen (template); /* Don't include trailing nul */
+ tempdir = secure_getenv ("TEMP");
+ fd = tempfile_open (tempdir, &fname);
}
+#endif
+ if (fd == -1)
+ fd = tempfile_open (P_tmpdir, &fname);
+
+ opp->file = fname;
+ opp->file_len = strlen (fname); /* Don't include trailing nul */
return fd;
}
-/* regular_file()-- Open a regular file.
- * Change flags->action if it is ACTION_UNSPECIFIED on entry,
- * unless an error occurs.
- * Returns the descriptor, which is less than zero on error. */
+/* regular_file2()-- Open a regular file.
+ Change flags->action if it is ACTION_UNSPECIFIED on entry,
+ unless an error occurs.
+ Returns the descriptor, which is less than zero on error. */
static int
-regular_file (st_parameter_open *opp, unit_flags *flags)
+regular_file2 (const char *path, st_parameter_open *opp, unit_flags *flags)
{
- char path[PATH_MAX + 1];
int mode;
int rwflag;
- int crflag;
+ int crflag, crflag2;
int fd;
- if (unpack_filename (path, opp->file, opp->file_len))
+#ifdef __CYGWIN__
+ if (opp->file_len == 7)
{
- errno = ENOENT; /* Fake an OS error */
- return -1;
+ 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;
+ }
}
- rwflag = 0;
+ if (opp->file_len == 6 && strncmp (path, "CONIN$", 6) == 0)
+ {
+ fd = open ("CONIN$", O_RDONLY);
+ flags->action = ACTION_READ;
+ return fd;
+ }
+#endif
switch (flags->action)
{
break;
case STATUS_UNKNOWN:
- case STATUS_SCRATCH:
- crflag = O_CREAT;
+ if (rwflag == O_RDONLY)
+ crflag = 0;
+ else
+ crflag = O_CREAT;
break;
case STATUS_REPLACE:
break;
default:
+ /* Note: STATUS_SCRATCH is handled by tempfile () and should
+ never be seen here. */
internal_error (&opp->common, "regular_file(): Bad status");
}
crflag |= O_BINARY;
#endif
+#ifdef O_CLOEXEC
+ crflag |= O_CLOEXEC;
+#endif
+
mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
- fd = open (path, rwflag | crflag, mode);
+ TEMP_FAILURE_RETRY (fd = open (path, rwflag | crflag, mode));
if (flags->action != ACTION_UNSPECIFIED)
return fd;
flags->action = ACTION_READWRITE;
return fd;
}
- if (errno != EACCES && errno != EROFS)
+ if (errno != EACCES && errno != EPERM && errno != EROFS)
return fd;
/* retry for read-only access */
rwflag = O_RDONLY;
- fd = open (path, rwflag | crflag, mode);
+ if (flags->status == STATUS_UNKNOWN)
+ crflag2 = crflag & ~(O_CREAT);
+ else
+ crflag2 = crflag;
+ TEMP_FAILURE_RETRY (fd = open (path, rwflag | crflag2, mode));
if (fd >=0)
{
flags->action = ACTION_READ;
return fd; /* success */
}
- if (errno != EACCES)
+ if (errno != EACCES && errno != EPERM && errno != ENOENT)
return fd; /* failure */
/* retry for write-only access */
rwflag = O_WRONLY;
- fd = open (path, rwflag | crflag, mode);
+ TEMP_FAILURE_RETRY (fd = open (path, rwflag | crflag, mode));
if (fd >=0)
{
flags->action = ACTION_WRITE;
}
+/* Lock the file, if necessary, based on SHARE flags. */
+
+#if defined(HAVE_FCNTL) && defined(F_SETLK) && defined(F_UNLCK)
+static int
+open_share (st_parameter_open *opp, int fd, unit_flags *flags)
+{
+ int r = 0;
+ struct flock f;
+ if (fd == STDOUT_FILENO || fd == STDERR_FILENO || fd == STDIN_FILENO)
+ return 0;
+
+ f.l_start = 0;
+ f.l_len = 0;
+ f.l_whence = SEEK_SET;
+
+ switch (flags->share)
+ {
+ case SHARE_DENYNONE:
+ f.l_type = F_RDLCK;
+ r = fcntl (fd, F_SETLK, &f);
+ break;
+ case SHARE_DENYRW:
+ /* Must be writable to hold write lock. */
+ if (flags->action == ACTION_READ)
+ {
+ generate_error (&opp->common, LIBERROR_BAD_ACTION,
+ "Cannot set write lock on file opened for READ");
+ return -1;
+ }
+ f.l_type = F_WRLCK;
+ r = fcntl (fd, F_SETLK, &f);
+ break;
+ case SHARE_UNSPECIFIED:
+ default:
+ break;
+ }
+
+ return r;
+}
+#else
+static int
+open_share (st_parameter_open *opp __attribute__ ((unused)),
+ int fd __attribute__ ((unused)),
+ unit_flags *flags __attribute__ ((unused)))
+{
+ return 0;
+}
+#endif /* defined(HAVE_FCNTL) ... */
+
+
+/* Wrapper around regular_file2, to make sure we free the path after
+ we're done. */
+
+static int
+regular_file (st_parameter_open *opp, unit_flags *flags)
+{
+ char *path = fc_strdup (opp->file, opp->file_len);
+ int fd = regular_file2 (path, opp, flags);
+ free (path);
+ return fd;
+}
+
/* open_external()-- Open an external file, unix specific version.
- * Change flags->action if it is ACTION_UNSPECIFIED on entry.
- * Returns NULL on operating system error. */
+ Change flags->action if it is ACTION_UNSPECIFIED on entry.
+ Returns NULL on operating system error. */
stream *
open_external (st_parameter_open *opp, unit_flags *flags)
{
- int fd, prot;
+ int fd;
if (flags->status == STATUS_SCRATCH)
{
fd = tempfile (opp);
if (flags->action == ACTION_UNSPECIFIED)
- flags->action = ACTION_READWRITE;
+ flags->action = flags->readonly ? ACTION_READ : ACTION_READWRITE;
#if HAVE_UNLINK_OPEN_FILE
/* We can unlink scratch files now and it will go away when closed. */
else
{
/* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
- * if it succeeds */
+ if it succeeds */
fd = regular_file (opp, flags);
+#ifndef O_CLOEXEC
+ set_close_on_exec (fd);
+#endif
}
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 (&opp->common, "open_external(): Bad action");
- }
+ if (open_share (opp, fd, flags) < 0)
+ return NULL;
- return fd_to_stream (fd, prot);
+ return fd_to_stream (fd, flags->form == FORM_UNFORMATTED);
}
/* input_stream()-- Return a stream pointer to the default input stream.
- * Called on initialization. */
+ Called on initialization. */
stream *
input_stream (void)
{
- return fd_to_stream (STDIN_FILENO, PROT_READ);
+ return fd_to_stream (STDIN_FILENO, false);
}
/* output_stream()-- Return a stream pointer to the default output stream.
- * Called on initialization. */
+ Called on initialization. */
stream *
output_stream (void)
{
- stream * s;
+ stream *s;
#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
setmode (STDOUT_FILENO, O_BINARY);
#endif
- s = fd_to_stream (STDOUT_FILENO, PROT_WRITE);
+ s = fd_to_stream (STDOUT_FILENO, false);
return s;
}
/* error_stream()-- Return a stream pointer to the default error stream.
- * Called on initialization. */
+ Called on initialization. */
stream *
error_stream (void)
{
- stream * s;
+ stream *s;
#if defined(HAVE_CRLF) && defined(HAVE_SETMODE)
setmode (STDERR_FILENO, O_BINARY);
#endif
- s = fd_to_stream (STDERR_FILENO, PROT_WRITE);
+ s = fd_to_stream (STDERR_FILENO, false);
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 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);
-
- 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
-
- }
-#endif
-
- 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()-- Given an open stream and a fortran string
- * that is a filename, figure out if the file is the same as the
- * filename. */
+ that is a filename, figure out if the file is the same as the
+ filename. */
int
-compare_file_filename (gfc_unit *u, const char *name, int len)
+compare_file_filename (gfc_unit *u, const char *name, gfc_charlen_type len)
{
- char path[PATH_MAX + 1];
- struct stat st1;
+ struct stat st;
+ int ret;
#ifdef HAVE_WORKING_STAT
- struct stat st2;
+ 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 */
+ char *path = fc_strdup (name, len);
/* If the filename doesn't exist, then there is no match with the
- * existing file. */
+ existing file. */
- if (stat (path, &st1) < 0)
- return 0;
+ if (TEMP_FAILURE_RETRY (stat (path, &st)) < 0)
+ {
+ ret = 0;
+ goto done;
+ }
#ifdef HAVE_WORKING_STAT
- fstat (((unix_stream *) (u->s))->fd, &st2);
- return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
+ s = (unix_stream *) (u->s);
+ ret = (st.st_dev == s->st_dev) && (st.st_ino == s->st_ino);
+ goto done;
#else
# ifdef __MINGW32__
id1 = id_from_path (path);
id2 = id_from_fd (((unix_stream *) (u->s))->fd);
if (id1 || id2)
- return (id1 == id2);
+ {
+ ret = (id1 == id2);
+ goto done;
+ }
# endif
-
- if (len != u->file_len)
- return 0;
- return (memcmp(path, u->file, len) == 0);
+ if (u->filename)
+ ret = (strcmp(path, u->filename) == 0);
+ else
+ ret = 0;
#endif
+ done:
+ free (path);
+ return ret;
}
# define FIND_FILE0_DECL struct stat *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
+# define FIND_FILE0_DECL uint64_t id, const char *path
+# define FIND_FILE0_ARGS id, path
#endif
/* find_file0()-- Recursive work function for find_file() */
return NULL;
#ifdef HAVE_WORKING_STAT
- if (u->s != NULL
- && fstat (((unix_stream *) u->s)->fd, &st[1]) >= 0 &&
- st[0].st_dev == st[1].st_dev && st[0].st_ino == st[1].st_ino)
- return u;
+ 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))
}
else
# endif
- if (compare_string (u->file_len, u->file, file_len, file) == 0)
+ if (u->filename && strcmp (u->filename, path) == 0)
return u;
#endif
/* find_file()-- Take the current filename and see if there is a unit
- * that has the file already open. Returns a pointer to the unit if so. */
+ that has the file already open. Returns a pointer to the unit if so. */
gfc_unit *
find_file (const char *file, gfc_charlen_type file_len)
{
- char path[PATH_MAX + 1];
- struct stat st[2];
+ struct stat st[1];
gfc_unit *u;
- uint64_t id;
+#if defined(__MINGW32__) && !HAVE_WORKING_STAT
+ uint64_t id = 0ULL;
+#endif
- if (unpack_filename (path, file, file_len))
- return NULL;
+ char *path = fc_strdup (file, file_len);
- if (stat (path, &st[0]) < 0)
- return NULL;
+ if (TEMP_FAILURE_RETRY (stat (path, &st[0])) < 0)
+ {
+ u = NULL;
+ goto done;
+ }
#if defined(__MINGW32__) && !HAVE_WORKING_STAT
id = id_from_path (path);
-#else
- id = 0;
#endif
- __gthread_mutex_lock (&unit_lock);
+ LOCK (&unit_lock);
retry:
u = find_file0 (unit_root, FIND_FILE0_ARGS);
if (u != NULL)
if (! __gthread_mutex_trylock (&u->lock))
{
/* assert (u->closed == 0); */
- __gthread_mutex_unlock (&unit_lock);
- return u;
+ UNLOCK (&unit_lock);
+ goto done;
}
inc_waiting_locked (u);
}
- __gthread_mutex_unlock (&unit_lock);
+ UNLOCK (&unit_lock);
if (u != NULL)
{
- __gthread_mutex_lock (&u->lock);
+ LOCK (&u->lock);
if (u->closed)
{
- __gthread_mutex_lock (&unit_lock);
- __gthread_mutex_unlock (&u->lock);
+ LOCK (&unit_lock);
+ UNLOCK (&u->lock);
if (predec_waiting_locked (u) == 0)
- free_mem (u);
+ free (u);
goto retry;
}
dec_waiting_unlocked (u);
}
+ done:
+ free (path);
return u;
}
return u;
if (u->s)
sflush (u->s);
- __gthread_mutex_unlock (&u->lock);
+ UNLOCK (&u->lock);
}
u = u->right;
}
gfc_unit *u;
int min_unit = 0;
- __gthread_mutex_lock (&unit_lock);
+ 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);
+ UNLOCK (&unit_lock);
if (u == NULL)
return;
- __gthread_mutex_lock (&u->lock);
+ 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);
+ LOCK (&unit_lock);
+ UNLOCK (&u->lock);
(void) predec_waiting_locked (u);
}
else
{
- __gthread_mutex_lock (&unit_lock);
- __gthread_mutex_unlock (&u->lock);
+ LOCK (&unit_lock);
+ UNLOCK (&u->lock);
if (predec_waiting_locked (u) == 0)
- free_mem (u);
+ free (u);
}
}
while (1);
}
-/* delete_file()-- Given a unit structure, delete the file associated
- * with the unit. Returns nonzero if something went wrong. */
+/* Unlock the unit if necessary, based on SHARE flags. */
int
-delete_file (gfc_unit * u)
-{
- char path[PATH_MAX + 1];
-
- if (unpack_filename (path, u->file, u->file_len))
- { /* Shouldn't be possible */
- errno = ENOENT;
- return 1;
- }
+close_share (gfc_unit *u __attribute__ ((unused)))
+{
+ int r = 0;
+#if defined(HAVE_FCNTL) && defined(F_SETLK) && defined(F_UNLCK)
+ unix_stream *s = (unix_stream *) u->s;
+ int fd = s->fd;
+ struct flock f;
+
+ switch (u->flags.share)
+ {
+ case SHARE_DENYRW:
+ case SHARE_DENYNONE:
+ if (fd != STDOUT_FILENO && fd != STDERR_FILENO && fd != STDIN_FILENO)
+ {
+ f.l_start = 0;
+ f.l_len = 0;
+ f.l_whence = SEEK_SET;
+ f.l_type = F_UNLCK;
+ r = fcntl (fd, F_SETLK, &f);
+ }
+ break;
+ case SHARE_UNSPECIFIED:
+ default:
+ break;
+ }
- return unlink (path);
+#endif
+ return r;
}
/* file_exists()-- Returns nonzero if the current filename exists on
- * the system */
+ the system */
int
file_exists (const char *file, gfc_charlen_type file_len)
{
- char path[PATH_MAX + 1];
- struct stat statbuf;
+ char *path = fc_strdup (file, file_len);
+ int res = !(access (path, F_OK));
+ free (path);
+ return res;
+}
- if (unpack_filename (path, file, file_len))
- return 0;
- if (stat (path, &statbuf) < 0)
- return 0;
+/* file_size()-- Returns the size of the file. */
- return 1;
+GFC_IO_INT
+file_size (const char *file, gfc_charlen_type file_len)
+{
+ char *path = fc_strdup (file, file_len);
+ struct stat statbuf;
+ int err;
+ TEMP_FAILURE_RETRY (err = stat (path, &statbuf));
+ free (path);
+ if (err == -1)
+ return -1;
+ return (GFC_IO_INT) statbuf.st_size;
}
-
-
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
- * string. */
+ file is suitable for sequential access. Returns a C-style
+ string. */
const char *
-inquire_sequential (const char *string, int len)
+inquire_sequential (const char *string, gfc_charlen_type len)
{
- char path[PATH_MAX + 1];
struct stat statbuf;
- if (string == NULL ||
- unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
+ if (string == NULL)
+ return unknown;
+
+ char *path = fc_strdup (string, len);
+ int err;
+ TEMP_FAILURE_RETRY (err = stat (path, &statbuf));
+ free (path);
+ if (err == -1)
return unknown;
if (S_ISREG (statbuf.st_mode) ||
/* inquire_direct()-- Given a fortran string, determine if the file is
- * suitable for direct access. Returns a C-style string. */
+ suitable for direct access. Returns a C-style string. */
const char *
-inquire_direct (const char *string, int len)
+inquire_direct (const char *string, gfc_charlen_type len)
{
- char path[PATH_MAX + 1];
struct stat statbuf;
- if (string == NULL ||
- unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
+ if (string == NULL)
+ return unknown;
+
+ char *path = fc_strdup (string, len);
+ int err;
+ TEMP_FAILURE_RETRY (err = stat (path, &statbuf));
+ free (path);
+ if (err == -1)
return unknown;
if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
/* inquire_formatted()-- Given a fortran string, determine if the file
- * is suitable for formatted form. Returns a C-style string. */
+ is suitable for formatted form. Returns a C-style string. */
const char *
-inquire_formatted (const char *string, int len)
+inquire_formatted (const char *string, gfc_charlen_type len)
{
- char path[PATH_MAX + 1];
struct stat statbuf;
- if (string == NULL ||
- unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
+ if (string == NULL)
+ return unknown;
+
+ char *path = fc_strdup (string, len);
+ int err;
+ TEMP_FAILURE_RETRY (err = stat (path, &statbuf));
+ free (path);
+ if (err == -1)
return unknown;
if (S_ISREG (statbuf.st_mode) ||
/* inquire_unformatted()-- Given a fortran string, determine if the file
- * is suitable for unformatted form. Returns a C-style string. */
+ is suitable for unformatted form. Returns a C-style string. */
const char *
-inquire_unformatted (const char *string, int len)
+inquire_unformatted (const char *string, gfc_charlen_type len)
{
return inquire_formatted (string, len);
}
-#ifndef HAVE_ACCESS
-
-#ifndef W_OK
-#define W_OK 2
-#endif
-
-#ifndef R_OK
-#define R_OK 4
-#endif
-
-/* Fallback implementation of access() on systems that don't have it.
- Only modes R_OK and W_OK are used in this file. */
-
-static int
-fallback_access (const char *path, int mode)
-{
- if ((mode & R_OK) && open (path, O_RDONLY) < 0)
- return -1;
-
- if ((mode & W_OK) && open (path, O_WRONLY) < 0)
- return -1;
-
- return 0;
-}
-
-#undef access
-#define access fallback_access
-#endif
-
-
/* inquire_access()-- Given a fortran string, determine if the file is
- * suitable for access. */
+ suitable for access. */
static const char *
-inquire_access (const char *string, int len, int mode)
+inquire_access (const char *string, gfc_charlen_type len, int mode)
{
- char path[PATH_MAX + 1];
-
- if (string == NULL || unpack_filename (path, string, len) ||
- access (path, mode) < 0)
+ if (string == NULL)
+ return no;
+ char *path = fc_strdup (string, len);
+ int res = access (path, mode);
+ free (path);
+ if (res == -1)
return no;
return yes;
/* inquire_read()-- Given a fortran string, determine if the file is
- * suitable for READ access. */
+ suitable for READ access. */
const char *
-inquire_read (const char *string, int len)
+inquire_read (const char *string, gfc_charlen_type len)
{
return inquire_access (string, len, R_OK);
}
/* inquire_write()-- Given a fortran string, determine if the file is
- * suitable for READ access. */
+ suitable for READ access. */
const char *
-inquire_write (const char *string, int len)
+inquire_write (const char *string, gfc_charlen_type len)
{
return inquire_access (string, len, W_OK);
}
/* inquire_readwrite()-- Given a fortran string, determine if the file is
- * suitable for read and write access. */
+ suitable for read and write access. */
const char *
-inquire_readwrite (const char *string, int len)
+inquire_readwrite (const char *string, gfc_charlen_type len)
{
return inquire_access (string, len, R_OK | W_OK);
}
-/* file_length()-- Return the file length in bytes, -1 if unknown */
-
-gfc_offset
-file_length (stream * s)
-{
- off_t 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;
-}
-
-
-/* is_seekable()-- Return nonzero if the stream is seekable, zero if
- * it is not */
-
-int
-is_seekable (stream *s)
-{
- /* By convention, if file_length == -1, the file is not
- seekable. */
- return ((unix_stream *) s)->file_length!=-1;
-}
-
-
-/* is_special()-- Return nonzero if the stream is not a regular file. */
-
-int
-is_special (stream *s)
-{
- return ((unix_stream *) s)->special_file;
-}
-
-
int
stream_isatty (stream *s)
{
return isatty (((unix_stream *) s)->fd);
}
-char *
-stream_ttyname (stream *s __attribute__ ((unused)))
-{
-#ifdef HAVE_TTYNAME
- return ttyname (((unix_stream *) s)->fd);
+int
+stream_ttyname (stream *s __attribute__ ((unused)),
+ char *buf __attribute__ ((unused)),
+ size_t buflen __attribute__ ((unused)))
+{
+#ifdef HAVE_TTYNAME_R
+ return ttyname_r (((unix_stream *)s)->fd, buf, buflen);
+#elif defined HAVE_TTYNAME
+ char *p;
+ size_t plen;
+ p = ttyname (((unix_stream *)s)->fd);
+ if (!p)
+ return errno;
+ plen = strlen (p);
+ if (buflen < plen)
+ plen = buflen;
+ memcpy (buf, p, plen);
+ return 0;
#else
- return NULL;
+ return ENOSYS;
#endif
}
+
+
/* How files are stored: This is an operating-system specific issue,
and therefore belongs here. There are three cases to consider.
projects / thirdparty / gcc.git / blobdiff