-/* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
the Free Software Foundation; either version 2, or (at your option)
any later version.
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#define PROT_WRITE 2
#endif
+/* These flags aren't defined on all targets (mingw32), so provide them
+ here. */
+#ifndef S_IRGRP
+#define S_IRGRP 0
+#endif
+
+#ifndef S_IWGRP
+#define S_IWGRP 0
+#endif
+
+#ifndef S_IROTH
+#define S_IROTH 0
+#endif
+
+#ifndef S_IWOTH
+#define S_IWOTH 0
+#endif
+
/* This implementation of stream I/O is based on the paper:
*
* "Exploiting the advantages of mapped files for stream I/O",
unix_stream * str = (unix_stream*)st;
if (pos_off < 0)
{
- str->active += pos_off;
- if (str->active < 0)
- str->active = 0;
+ str->logical_offset += pos_off;
- str->logical_offset += pos_off;
-
- if (str->dirty_offset+str->ndirty > str->logical_offset)
+ if (str->dirty_offset + str->ndirty > str->logical_offset)
{
- if (str->ndirty + pos_off > 0)
- str->ndirty += pos_off ;
+ if (str->ndirty + pos_off > 0)
+ str->ndirty += pos_off;
else
{
str->dirty_offset += pos_off + pos_off;
- str->ndirty = 0 ;
+ str->ndirty = 0;
}
}
- return pos_off ;
+ return pos_off;
}
- return 0 ;
+ return 0;
}
input = output = error = 0;
-/* Unix allocates the lowest descriptors first, so a loop is not
- * required, but this order is. */
+ /* Unix allocates the lowest descriptors first, so a loop is not
+ required, but this order is. */
if (fd == STDIN_FILENO)
{
const char *
get_oserror (void)
{
-
return strerror (errno);
}
void
sys_exit (int code)
{
-
exit (code);
}
-
/*********************************************************************
File descriptor stream functions
*********************************************************************/
static try
fd_flush (unix_stream * s)
{
-
if (s->ndirty == 0)
return SUCCESS;;
* to come next. */
static void
-fd_alloc (unix_stream * s, gfc_offset where, int *len)
+fd_alloc (unix_stream * s, gfc_offset where,
+ int *len __attribute__ ((unused)))
{
char *new_buffer;
int n, read_len;
s->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;
static try
fd_sfree (unix_stream * s)
{
-
if (s->ndirty != 0 &&
(s->buffer != s->small_buffer || options.all_unbuffered ||
s->unbuffered))
static int
fd_seek (unix_stream * s, gfc_offset offset)
{
-
s->physical_offset = s->logical_offset = offset;
return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
static try
fd_truncate (unix_stream * s)
{
-
if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
return FAILURE;
/* non-seekable files, like terminals and fifo's fail the lseek.
the fd is a regular file at this point */
+#ifdef HAVE_FTRUNCATE
if (ftruncate (s->fd, s->logical_offset))
- {
- return FAILURE;
- }
+#else
+#ifdef HAVE_CHSIZE
+ if (chsize (s->fd, s->logical_offset))
+#endif
+#endif
+ {
+ s->physical_offset = s->file_length = 0;
+ return FAILURE;
+ }
s->physical_offset = s->file_length = s->logical_offset;
static try
fd_close (unix_stream * s)
{
-
if (fd_flush (s) == FAILURE)
return FAILURE;
if (s->buffer != NULL && s->buffer != s->small_buffer)
free_mem (s->buffer);
- if (close (s->fd) < 0)
- return FAILURE;
+ if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
+ {
+ if (close (s->fd) < 0)
+ return FAILURE;
+ }
free_mem (s);
static void
fd_open (unix_stream * s)
{
-
if (isatty (s->fd))
s->unbuffered = 1;
static try
mmap_flush (unix_stream * s)
{
-
if (!s->mmaped)
return fd_flush (s);
* guaranteed to be mappable. */
static try
-mmap_alloc (unix_stream * s, gfc_offset where, int *len)
+mmap_alloc (unix_stream * s, gfc_offset where,
+ int *len __attribute__ ((unused)))
{
gfc_offset offset;
int length;
}
if ((s->buffer == NULL || s->buffer_offset > where ||
- where + *len > s->buffer_offset + s->active) &&
+ where + *len > s->buffer_offset + s->active ||
+ where < s->buffer_offset + s->active) &&
mmap_alloc (s, where, len) == FAILURE)
return NULL;
static int
mmap_seek (unix_stream * s, gfc_offset offset)
{
-
s->logical_offset = offset;
return SUCCESS;
}
static try
-mmap_sfree (unix_stream * s)
+mmap_sfree (unix_stream * s __attribute__ ((unused)))
{
-
return SUCCESS;
}
* mmap()-ed, we fall back to the file descriptor functions. */
static try
-mmap_open (unix_stream * s)
+mmap_open (unix_stream * s __attribute__ ((unused)))
{
char *p;
int i;
static int
mem_seek (unix_stream * s, gfc_offset offset)
{
-
if (offset > s->file_length)
{
errno = ESPIPE;
static int
-mem_truncate (unix_stream * s)
+mem_truncate (unix_stream * s __attribute__ ((unused)))
{
-
return SUCCESS;
}
static try
-mem_sfree (unix_stream * s)
+mem_sfree (unix_stream * s __attribute__ ((unused)))
{
-
return SUCCESS;
}
void
empty_internal_buffer(stream *strm)
{
- unix_stream * s = (unix_stream *) strm;
- memset(s->buffer, ' ', s->file_length);
+ unix_stream * s = (unix_stream *) strm;
+ memset(s->buffer, ' ', s->file_length);
}
/* open_internal()-- Returns a stream structure from an internal file */
unix_stream *s;
s = get_mem (sizeof (unix_stream));
+ memset (s, '\0', sizeof (unix_stream));
s->buffer = base;
s->buffer_offset = 0;
* around it. */
static stream *
-fd_to_stream (int fd, int prot)
+fd_to_stream (int fd, int prot, int avoid_mmap)
{
struct stat statbuf;
unix_stream *s;
s = get_mem (sizeof (unix_stream));
+ memset (s, '\0', sizeof (unix_stream));
s->fd = fd;
s->buffer_offset = 0;
s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
#if HAVE_MMAP
- mmap_open (s);
+ if (avoid_mmap)
+ fd_open (s);
+ else
+ mmap_open (s);
#else
fd_open (s);
#endif
}
+/* Given the Fortran unit number, convert it to a C file descriptor. */
+
+int
+unit_to_fd(int unit)
+{
+ gfc_unit *us;
+
+ us = find_unit(unit);
+ if (us == NULL)
+ return -1;
+
+ return ((unix_stream *) us->s)->fd;
+}
+
+
/* unpack_filename()-- Given a fortran string and a pointer to a
* buffer that is PATH_MAX characters, convert the fortran string to a
* C string in the buffer. Returns nonzero if this is not possible. */
static int
unpack_filename (char *cstring, const char *fstring, int len)
{
-
len = fstrlen (fstring, len);
if (len >= PATH_MAX)
return 1;
/* tempfile()-- Generate a temporary filename for a scratch file and
* open it. mkstemp() opens the file for reading and writing, but the
* library mode prevents anything that is not allowed. The descriptor
- * is returns, which is less than zero on error. The template is
- * pointed to by ioparm.file, which is copied into the unit structure
+ * is returned, which is -1 on error. The template is pointed to by
+ * ioparm.file, which is copied into the unit structure
* and freed later. */
static int
template = get_mem (strlen (tempdir) + 20);
- st_sprintf (template, "%s/gfortantmpXXXXXX", tempdir);
+ st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
+
+#ifdef HAVE_MKSTEMP
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;
+
+#endif /* HAVE_MKSTEMP */
+
if (fd < 0)
free_mem (template);
else
}
-/* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
+/* regular_file()-- Open a regular file.
+ * Change flags->action if it is ACTION_UNSPECIFIED on entry,
+ * unless an error occurs.
+ * Returns the descriptor, which is less than zero on error. */
static int
-regular_file (unit_action action, unit_status status)
+regular_file (unit_flags *flags)
{
char path[PATH_MAX + 1];
- struct stat statbuf;
int mode;
+ int rwflag;
+ int crflag;
+ int fd;
if (unpack_filename (path, ioparm.file, ioparm.file_len))
{
return -1;
}
- mode = 0;
+ rwflag = 0;
- switch (action)
+ switch (flags->action)
{
case ACTION_READ:
- mode = O_RDONLY;
+ rwflag = O_RDONLY;
break;
case ACTION_WRITE:
- mode = O_WRONLY;
+ rwflag = O_WRONLY;
break;
case ACTION_READWRITE:
- mode = O_RDWR;
+ case ACTION_UNSPECIFIED:
+ rwflag = O_RDWR;
break;
default:
internal_error ("regular_file(): Bad action");
}
- switch (status)
+ switch (flags->status)
{
case STATUS_NEW:
- mode |= O_CREAT | O_EXCL;
+ crflag = O_CREAT | O_EXCL;
break;
- case STATUS_OLD: /* file must exist, so check for its existence */
- if (stat (path, &statbuf) < 0)
- return -1;
+ case STATUS_OLD: /* open will fail if the file does not exist*/
+ crflag = 0;
break;
case STATUS_UNKNOWN:
case STATUS_SCRATCH:
- mode |= O_CREAT;
+ crflag = O_CREAT;
break;
case STATUS_REPLACE:
- mode |= O_CREAT | O_TRUNC;
+ crflag = O_CREAT | O_TRUNC;
break;
default:
internal_error ("regular_file(): Bad status");
}
- // mode |= O_LARGEFILE;
+ /* rwflag |= O_LARGEFILE; */
+
+ 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 open (path, mode,
- S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
+ if (fd >= 0)
+ {
+ flags->action = ACTION_READWRITE;
+ return fd;
+ }
+ if (errno != EACCES)
+ return fd;
+
+ /* retry for read-only access */
+ rwflag = O_RDONLY;
+ fd = open (path, rwflag | crflag, mode);
+ if (fd >=0)
+ {
+ flags->action = ACTION_READ;
+ return fd; /* success */
+ }
+
+ if (errno != EACCES)
+ return fd; /* failure */
+
+ /* retry for write-only access */
+ rwflag = O_WRONLY;
+ fd = open (path, rwflag | crflag, mode);
+ if (fd >=0)
+ {
+ flags->action = ACTION_WRITE;
+ return fd; /* success */
+ }
+ return fd; /* failure */
}
/* open_external()-- Open an external file, unix specific version.
+ * Change flags->action if it is ACTION_UNSPECIFIED on entry.
* Returns NULL on operating system error. */
stream *
-open_external (unit_action action, unit_status status)
+open_external (unit_flags *flags)
{
int fd, prot;
- fd =
- (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
+ if (flags->status == STATUS_SCRATCH)
+ {
+ fd = tempfile ();
+ if (flags->action == ACTION_UNSPECIFIED)
+ flags->action = ACTION_READWRITE;
+ /* We can unlink scratch files now and it will go away when closed. */
+ unlink (ioparm.file);
+ }
+ else
+ {
+ /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
+ * if it succeeds */
+ fd = regular_file (flags);
+ }
if (fd < 0)
return NULL;
fd = fix_fd (fd);
- switch (action)
+ switch (flags->action)
{
case ACTION_READ:
prot = PROT_READ;
internal_error ("open_external(): Bad action");
}
- /* If this is a scratch file, we can unlink it now and the file will
- * go away when it is closed. */
-
- if (status == STATUS_SCRATCH)
- unlink (ioparm.file);
-
- return fd_to_stream (fd, prot);
+ return fd_to_stream (fd, prot, 0);
}
stream *
input_stream (void)
{
-
- return fd_to_stream (STDIN_FILENO, PROT_READ);
+ return fd_to_stream (STDIN_FILENO, PROT_READ, 1);
}
-/* 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);
+ return fd_to_stream (STDOUT_FILENO, PROT_WRITE, 1);
}
+/* error_stream()-- Return a stream pointer to the default error stream.
+ * Called on initialization. */
+
+stream *
+error_stream (void)
+{
+ return fd_to_stream (STDERR_FILENO, PROT_WRITE, 1);
+}
+
/* 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
{
unix_stream *us;
- us = (unix_stream *) s;
+ if (!is_seekable (s))
+ return 0;
- if (!us->mmaped)
- return 0; /* File is not seekable */
+ us = (unix_stream *) s;
return us->logical_offset == 0;
}
{
unix_stream *us;
- us = (unix_stream *) s;
+ if (!is_seekable (s))
+ return 0;
- if (!us->mmaped)
- return 0; /* File is not seekable */
+ us = (unix_stream *) s;
return us->logical_offset == us->dirty_offset;
}
const char *
inquire_unformatted (const char *string, int len)
{
-
return inquire_formatted (string, len);
}
const char *
inquire_read (const char *string, int len)
{
-
return inquire_access (string, len, R_OK);
}
const char *
inquire_write (const char *string, int len)
{
-
return inquire_access (string, len, W_OK);
}
const char *
inquire_readwrite (const char *string, int len)
{
-
return inquire_access (string, len, R_OK | W_OK);
}
gfc_offset
file_length (stream * s)
{
-
return ((unix_stream *) s)->file_length;
}
gfc_offset
file_position (stream * s)
{
-
return ((unix_stream *) s)->logical_offset;
}
OSDN Git Service
