X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=libgfortran%2Fio%2Funix.c;h=e66560f5839b1c5ea75c9209b0cd74836e193a6b;hb=d6e407223a35ef50b36f1d257a80eb358677bd31;hp=2026a3649278d75ca46f53f55ceaa69019e55ada;hpb=daad4fd542e74d22445a05a5be91761f094d4f27;p=pf3gnuchains%2Fgcc-fork.git diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index 2026a364927..e66560f5839 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1,41 +1,37 @@ -/* Copyright (C) 2002, 2003, 2004, 2005 +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle -This file is part of the GNU Fortran 95 runtime library (libgfortran). +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, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ /* Unix stream I/O module */ -#include "config.h" +#include "io.h" +#include "unix.h" #include #include #include -#include #include #include #include @@ -43,23 +39,69 @@ Boston, MA 02110-1301, USA. */ #include #include -#include "libgfortran.h" -#include "io.h" -#ifndef SSIZE_MAX -#define SSIZE_MAX SHRT_MAX -#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 + +#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 PATH_MAX -#define PATH_MAX 1024 #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 @@ -80,98 +122,75 @@ Boston, MA 02110-1301, USA. */ #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 */ - - int prot; - int ndirty; /* Dirty bytes starting at dirty_offset */ + char *buffer; /* Pointer to the buffer. */ + int fd; /* The POSIX file descriptor. */ - int special_file; /* =1 if the fd refers to a special file */ + int active; /* Length of valid bytes in the buffer */ - unsigned unbuffered: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->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 @@ -183,13 +202,13 @@ move_pos_offset (stream* st, int pos_off) 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); @@ -212,551 +231,398 @@ fix_fd (int fd) close (STDOUT_FILENO); if (error) close (STDERR_FILENO); +#endif return fd; } -int -is_preconnected (stream * s) + +/* 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 fd; fd = ((unix_stream *) s)->fd; - if (fd == STDIN_FILENO || fd == STDOUT_FILENO || fd == STDERR_FILENO) - return 1; - else - return 0; + if (fd == STDIN_FILENO) + fflush (stdin); + else if (fd == STDOUT_FILENO) + fflush (stdout); + else if (fd == STDERR_FILENO) + fflush (stderr); } -/* Reset a stream after reading/writing. Assumes that the buffers have - been flushed. */ +/* get_oserror()-- Get the most recent operating system error. For + * unix, this is errno. */ -inline static void -reset_stream (unix_stream * s, size_t bytes_rw) +const char * +get_oserror (void) { - s->physical_offset += bytes_rw; - s->logical_offset = s->physical_offset; - if (s->file_length != -1 && s->physical_offset > s->file_length) - s->file_length = s->physical_offset; + return strerror (errno); } -/* Read bytes into a buffer, allowing for short reads. If the nbytes - * argument is less on return than on entry, it is because we've hit - * the end of file. */ +/******************************************************************** +Raw I/O functions (read, write, seek, tell, truncate, close). + +These functions wrap the basic POSIX I/O syscalls. Any deviation in +semantics is a bug, except the following: write restarts in case +of being interrupted by a signal, and as the first argument the +functions take the unix_stream struct rather than an integer file +descriptor. Also, for POSIX read() and write() a nbyte argument larger +than SSIZE_MAX is undefined; here the type of nbyte is ssize_t rather +than size_t as for POSIX read/write. +*********************************************************************/ static int -do_read (unix_stream * s, void * buf, size_t * nbytes) +raw_flush (unix_stream * s __attribute__ ((unused))) { - ssize_t trans; - size_t bytes_left; - char *buf_st; - int status; - - status = 0; - bytes_left = *nbytes; - buf_st = (char *) buf; - - /* We must read in a loop since some systems don't restart system - calls in case of a signal. */ - while (bytes_left > 0) - { - /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3, - so we must read in chunks smaller than SSIZE_MAX. */ - trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX; - trans = read (s->fd, buf_st, trans); - if (trans < 0) - { - if (errno == EINTR) - continue; - else - { - status = errno; - break; - } - } - else if (trans == 0) /* We hit EOF. */ - break; - buf_st += trans; - bytes_left -= trans; - } - - *nbytes -= bytes_left; - return status; + return 0; } +static ssize_t +raw_read (unix_stream * s, void * buf, ssize_t nbyte) +{ + /* For read we can't do I/O in a loop like raw_write does, because + that will break applications that wait for interactive I/O. */ + return read (s->fd, buf, nbyte); +} -/* Write a buffer to a stream, allowing for short writes. */ - -static int -do_write (unix_stream * s, const void * buf, size_t * nbytes) +static ssize_t +raw_write (unix_stream * s, const void * buf, ssize_t nbyte) { - ssize_t trans; - size_t bytes_left; + ssize_t trans, bytes_left; char *buf_st; - int status; - status = 0; - bytes_left = *nbytes; + bytes_left = nbyte; buf_st = (char *) buf; /* We must write in a loop since some systems don't restart system calls in case of a signal. */ while (bytes_left > 0) { - /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3, - so we must write in chunks smaller than SSIZE_MAX. */ - trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX; - trans = write (s->fd, buf_st, trans); + trans = write (s->fd, buf_st, bytes_left); if (trans < 0) { if (errno == EINTR) continue; else - { - status = errno; - break; - } + return trans; } buf_st += trans; bytes_left -= trans; } - *nbytes -= bytes_left; - return status; + return nbyte - bytes_left; } - -/* get_oserror()-- Get the most recent operating system error. For - * unix, this is errno. */ - -const char * -get_oserror (void) +static gfc_offset +raw_seek (unix_stream * s, gfc_offset offset, int whence) { - return strerror (errno); + return lseek (s->fd, offset, whence); } - -/* sys_exit()-- Terminate the program with an exit code */ - -void -sys_exit (int code) -{ - exit (code); -} - - -/********************************************************************* - File descriptor stream functions -*********************************************************************/ - - -/* fd_flush()-- Write bytes that need to be written */ - -static try -fd_flush (unix_stream * s) +static gfc_offset +raw_tell (unix_stream * s) { - size_t writelen; - - if (s->ndirty == 0) - return SUCCESS;; - - if (s->physical_offset != s->dirty_offset && - lseek (s->fd, s->dirty_offset, SEEK_SET) < 0) - return FAILURE; - - writelen = s->ndirty; - if (do_write (s, s->buffer + (s->dirty_offset - s->buffer_offset), - &writelen) != 0) - return FAILURE; - - s->physical_offset = s->dirty_offset + writelen; - - /* don't increment file_length if the file is non-seekable */ - if (s->file_length != -1 && s->physical_offset > s->file_length) - s->file_length = s->physical_offset; - - s->ndirty -= writelen; - if (s->ndirty != 0) - return FAILURE; - - return SUCCESS; + return lseek (s->fd, 0, SEEK_CUR); } - -/* fd_alloc()-- Arrange a buffer such that the salloc() request can be - * satisfied. This subroutine gets the buffer ready for whatever is - * to come next. */ - -static void -fd_alloc (unix_stream * s, gfc_offset where, - int *len __attribute__ ((unused))) +static int +raw_truncate (unix_stream * s, gfc_offset length) { - char *new_buffer; - int n, read_len; +#ifdef __MINGW32__ + HANDLE h; + gfc_offset cur; - if (*len <= BUFFER_SIZE) + if (isatty (s->fd)) { - new_buffer = s->small_buffer; - read_len = BUFFER_SIZE; + errno = EBADF; + return -1; } - else + h = (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; + errno = EBADF; + goto error; } - else - { /* new buffer starts off empty */ - s->active = 0; - } - - s->buffer_offset = where; - - /* free the old buffer if necessary */ - - if (s->buffer != NULL && s->buffer != s->small_buffer) - free_mem (s->buffer); - - s->buffer = new_buffer; - s->len = read_len; + if (lseek (s->fd, cur, SEEK_SET) == -1) + return -1; + return 0; + error: + lseek (s->fd, cur, SEEK_SET); + return -1; +#elif defined HAVE_FTRUNCATE + return ftruncate (s->fd, length); +#elif defined HAVE_CHSIZE + return chsize (s->fd, length); +#else + runtime_error ("required ftruncate or chsize support not present"); + return -1; +#endif } - -/* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either - * we've already buffered the data or we need to load it. Returns - * NULL on I/O error. */ - -static char * -fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where) +static int +raw_close (unix_stream * s) { - gfc_offset m; - - if (where == -1) - where = s->logical_offset; - - if (s->buffer != NULL && s->buffer_offset <= where && - where + *len <= s->buffer_offset + s->active) - { - - /* Return a position within the current buffer */ - - s->logical_offset = where + *len; - return s->buffer + where - s->buffer_offset; - } - - fd_alloc (s, where, len); - - m = where + s->active; - - if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0) - return NULL; - - /* do_read() hangs on read from terminals for *BSD-systems. Only - use read() in that case. */ - - if (s->special_file) - { - ssize_t n; - - n = read (s->fd, s->buffer + s->active, s->len - s->active); - if (n < 0) - return NULL; - - s->physical_offset = where + n; - s->active += n; - } + int retval; + + if (s->fd != STDOUT_FILENO + && s->fd != STDERR_FILENO + && s->fd != STDIN_FILENO) + retval = close (s->fd); else - { - size_t n; - - n = s->len - s->active; - if (do_read (s, s->buffer + s->active, &n) != 0) - return NULL; - - s->physical_offset = where + n; - s->active += n; - } - - if (s->active < *len) - *len = s->active; /* Bytes actually available */ + retval = 0; + free (s); + return retval; +} - s->logical_offset = where + *len; +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; - return s->buffer; + s->buffer = NULL; + 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. */ +/********************************************************************* +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_w_at (unix_stream * s, int *len, gfc_offset where) +static int +buf_flush (unix_stream * s) { - gfc_offset n; + int writelen; - if (where == -1) - where = s->logical_offset; + /* Flushing in read mode means discarding read bytes. */ + s->active = 0; - if (s->buffer == NULL || s->buffer_offset > where || - where + *len > s->buffer_offset + s->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; - if (fd_flush (s) == FAILURE) - return NULL; - fd_alloc (s, where, len); - } + writelen = raw_write (s, s->buffer, s->ndirty); - /* Return a position within the current buffer */ - if (s->ndirty == 0 - || where > s->dirty_offset + s->ndirty - || s->dirty_offset > where + *len) - { /* Discontiguous blocks, start with a clean buffer. */ - /* Flush the buffer. */ - if (s->ndirty != 0) - fd_flush (s); - s->dirty_offset = where; - s->ndirty = *len; - } - else - { - gfc_offset start; /* Merge with the existing data. */ - if (where < s->dirty_offset) - start = where; - else - start = s->dirty_offset; - if (where + *len > s->dirty_offset + s->ndirty) - s->ndirty = where + *len - start; - else - s->ndirty = s->dirty_offset + s->ndirty - start; - s->dirty_offset = start; - } + s->physical_offset = s->buffer_offset + writelen; - s->logical_offset = where + *len; + /* 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; - if (where + *len > s->file_length) - s->file_length = where + *len; + s->ndirty -= writelen; + if (s->ndirty != 0) + return -1; - n = s->logical_offset - s->buffer_offset; - if (n > s->active) - s->active = n; +#ifdef _WIN32 + _commit (s->fd); +#endif - return s->buffer + where - s->buffer_offset; + return 0; } - -static try -fd_sfree (unix_stream * s) +static ssize_t +buf_read (unix_stream * s, void * buf, ssize_t nbyte) { - if (s->ndirty != 0 && - (s->buffer != s->small_buffer || options.all_unbuffered || - s->unbuffered)) - return fd_flush (s); - - return SUCCESS; -} - + if (s->active == 0) + s->buffer_offset = s->logical_offset; -static try -fd_seek (unix_stream * s, gfc_offset offset) -{ - if (s->physical_offset == offset) /* Are we lucky and avoid syscall? */ + /* 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 { - s->logical_offset = offset; - return SUCCESS; + /* 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->physical_offset = s->logical_offset = offset; - - return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS; + s->logical_offset += nbyte; + return nbyte; } - -/* 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 ssize_t +buf_write (unix_stream * s, const void * buf, ssize_t nbyte) { - if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1) - return FAILURE; - - /* non-seekable files, like terminals and fifo's fail the lseek. - Using ftruncate on a seekable special file (like /dev/null) - is undefined, so we treat it as if the ftruncate failed. - */ -#ifdef HAVE_FTRUNCATE - if (s->special_file || ftruncate (s->fd, s->logical_offset)) -#else -#ifdef HAVE_CHSIZE - if (s->special_file || chsize (s->fd, s->logical_offset)) -#endif -#endif + if (s->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) { - s->physical_offset = s->file_length = 0; - return FAILURE; + 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; } - - s->physical_offset = s->file_length = s->logical_offset; - - return SUCCESS; -} - - - - -/* Stream read function. Avoids using a buffer for big reads. The - interface is like POSIX read(), but the nbytes argument is a - pointer; on return it contains the number of bytes written. The - function return value is the status indicator (0 for success). */ - -static int -fd_read (unix_stream * s, void * buf, size_t * nbytes) -{ - void *p; - int tmp, status; - - if (*nbytes < BUFFER_SIZE && !s->unbuffered) + else { - tmp = *nbytes; - p = fd_alloc_r_at (s, &tmp, -1); - if (p) - { - *nbytes = tmp; - memcpy (buf, p, *nbytes); - return 0; - } + /* Flush, and either fill the buffer with the new data, or if + the request is bigger than the buffer size, write directly + bypassing the buffer. */ + buf_flush (s); + if (nbyte <= BUFFER_SIZE/2) + { + memcpy (s->buffer, buf, nbyte); + s->buffer_offset = s->logical_offset; + s->ndirty += nbyte; + } else { - *nbytes = 0; - return errno; + if (s->file_length != -1 && s->physical_offset != s->logical_offset) + { + if (lseek (s->fd, s->logical_offset, SEEK_SET) < 0) + return -1; + s->physical_offset = s->logical_offset; + } + + nbyte = raw_write (s, buf, nbyte); + s->physical_offset += nbyte; } } + s->logical_offset += nbyte; + /* Don't increment file_length if the file is non-seekable. */ + if (s->file_length != -1 && s->logical_offset > s->file_length) + s->file_length = s->logical_offset; + return nbyte; +} - /* If the request is bigger than BUFFER_SIZE we flush the buffers - and read directly. */ - if (fd_flush (s) == FAILURE) +static gfc_offset +buf_seek (unix_stream * s, gfc_offset offset, int whence) +{ + switch (whence) { - *nbytes = 0; - return errno; + case SEEK_SET: + break; + case SEEK_CUR: + offset += s->logical_offset; + break; + case SEEK_END: + offset += s->file_length; + break; + default: + return -1; } - - if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE) + if (offset < 0) { - *nbytes = 0; - return errno; + errno = EINVAL; + return -1; } - - status = do_read (s, buf, nbytes); - reset_stream (s, *nbytes); - return status; + s->logical_offset = offset; + return offset; } - -/* Stream write function. Avoids using a buffer for big writes. The - interface is like POSIX write(), but the nbytes argument is a - pointer; on return it contains the number of bytes written. The - function return value is the status indicator (0 for success). */ +static gfc_offset +buf_tell (unix_stream * s) +{ + return s->logical_offset; +} static int -fd_write (unix_stream * s, const void * buf, size_t * nbytes) +buf_truncate (unix_stream * s, gfc_offset length) { - void *p; - int tmp, status; + int r; - if (*nbytes < BUFFER_SIZE && !s->unbuffered) - { - tmp = *nbytes; - p = fd_alloc_w_at (s, &tmp, -1); - if (p) - { - *nbytes = tmp; - memcpy (p, buf, *nbytes); - return 0; - } - else - { - *nbytes = 0; - return errno; - } - } - - /* If the request is bigger than BUFFER_SIZE we flush the buffers - and write directly. */ - if (fd_flush (s) == FAILURE) - { - *nbytes = 0; - return errno; - } - - if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE) - { - *nbytes = 0; - return errno; - } - - status = do_write (s, buf, nbytes); - reset_stream (s, *nbytes); - return status; + if (buf_flush (s) != 0) + return -1; + r = raw_truncate (s, length); + if (r == 0) + s->file_length = length; + return r; } - -static try -fd_close (unix_stream * s) +static int +buf_close (unix_stream * s) { - if (fd_flush (s) == FAILURE) - return FAILURE; - - if (s->buffer != NULL && s->buffer != s->small_buffer) - free_mem (s->buffer); - - if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO) - { - if (close (s->fd) < 0) - return FAILURE; - } - - free_mem (s); - - return SUCCESS; + if (buf_flush (s) != 0) + return -1; + free (s->buffer); + return raw_close (s); } - -static void -fd_open (unix_stream * s) +static int +buf_init (unix_stream * s) { - if (isatty (s->fd)) - s->unbuffered = 1; - - s->st.alloc_r_at = (void *) fd_alloc_r_at; - s->st.alloc_w_at = (void *) fd_alloc_w_at; - s->st.sfree = (void *) fd_sfree; - s->st.close = (void *) fd_close; - s->st.seek = (void *) fd_seek; - s->st.truncate = (void *) fd_truncate; - s->st.read = (void *) fd_read; - s->st.write = (void *) fd_write; - - s->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; } - - /********************************************************************* memory stream functions - These are used for internal files @@ -767,37 +633,74 @@ fd_open (unix_stream * s) *********************************************************************/ - -static char * -mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where) +char * +mem_alloc_r (stream * strm, int * len) { + unix_stream * s = (unix_stream *) strm; gfc_offset n; - - if (where == -1) - where = s->logical_offset; + gfc_offset where = s->logical_offset; if (where < s->buffer_offset || where > s->buffer_offset + s->active) return NULL; + n = s->buffer_offset + s->active - where; + if (*len > n) + *len = n; + s->logical_offset = where + *len; + return s->buffer + (where - s->buffer_offset); +} + + +char * +mem_alloc_r4 (stream * strm, int * len) +{ + 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 (*len > n) *len = n; + s->logical_offset = where + *len; + + return s->buffer + (where - s->buffer_offset) * 4; +} + + +char * +mem_alloc_w (stream * strm, int * len) +{ + unix_stream * s = (unix_stream *) strm; + gfc_offset m; + gfc_offset where = s->logical_offset; + + m = where + *len; + + if (where < s->buffer_offset) + return NULL; + + if (m > s->file_length) + return NULL; + + s->logical_offset = m; + return s->buffer + (where - s->buffer_offset); } -static char * -mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where) +gfc_char4_t * +mem_alloc_w4 (stream * strm, int * len) { + unix_stream * s = (unix_stream *) strm; gfc_offset m; - - assert (*len >= 0); /* Negative values not allowed. */ - - if (where == -1) - where = s->logical_offset; + gfc_offset where = s->logical_offset; + gfc_char4_t *result = (gfc_char4_t *) s->buffer; m = where + *len; @@ -808,121 +711,194 @@ mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where) return NULL; s->logical_offset = m; - - return s->buffer + (where - s->buffer_offset); + return &result[where - s->buffer_offset]; } -/* Stream read function for internal units. This is not actually used - at the moment, as all internal IO is formatted and the formatted IO - routines use mem_alloc_r_at. */ +/* Stream read function for character(kine=1) internal units. */ -static int -mem_read (unix_stream * s, void * buf, size_t * nbytes) +static ssize_t +mem_read (stream * s, void * buf, ssize_t nbytes) { void *p; - int tmp; + int nb = nbytes; - tmp = *nbytes; - p = mem_alloc_r_at (s, &tmp, -1); + p = mem_alloc_r (s, &nb); if (p) { - *nbytes = tmp; - memcpy (buf, p, *nbytes); - return 0; + memcpy (buf, p, nb); + return (ssize_t) nb; } else + return 0; +} + + +/* Stream read function for chracter(kind=4) internal units. */ + +static ssize_t +mem_read4 (stream * s, void * buf, ssize_t nbytes) +{ + void *p; + int nb = nbytes; + + p = mem_alloc_r (s, &nb); + if (p) { - *nbytes = 0; - return errno; + memcpy (buf, p, nb); + return (ssize_t) nb; } + else + return 0; } -/* 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 write function for character(kind=1) internal units. */ -static int -mem_write (unix_stream * s, const void * buf, size_t * nbytes) +static ssize_t +mem_write (stream * s, const void * buf, ssize_t nbytes) { void *p; - int tmp; - - errno = 0; + int nb = nbytes; - tmp = *nbytes; - p = mem_alloc_w_at (s, &tmp, -1); + p = mem_alloc_w (s, &nb); if (p) { - *nbytes = tmp; - memcpy (p, buf, *nbytes); - return 0; + memcpy (p, buf, nb); + return (ssize_t) nb; } else + return 0; +} + + +/* Stream write function for character(kind=4) internal units. */ + +static ssize_t +mem_write4 (stream * s, const void * buf, ssize_t nwords) +{ + gfc_char4_t *p; + int nw = nwords; + + p = mem_alloc_w4 (s, &nw); + if (p) { - *nbytes = 0; - return errno; + 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 __attribute__ ((unused))) +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 __attribute__ ((unused))) +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; @@ -930,19 +906,18 @@ open_internal (char *base, int length) 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.read = (void *) mem_read; - s->st.write = (void *) mem_write; + 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; } @@ -952,9 +927,9 @@ open_internal (char *base, int length) * 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)); @@ -964,15 +939,37 @@ fd_to_stream (int fd, int prot) 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; + + s->st_dev = statbuf.st_dev; + s->st_ino = statbuf.st_ino; s->special_file = !S_ISREG (statbuf.st_mode); - fd_open (s); + 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; } @@ -981,15 +978,18 @@ fd_to_stream (int fd, int prot) /* 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; } @@ -1000,6 +1000,8 @@ unit_to_fd(int unit) 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; @@ -1015,54 +1017,79 @@ unpack_filename (char *cstring, const char *fstring, int len) * 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 -#ifdef HAVE_CRLF + 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); + S_IREAD | S_IWRITE); #else fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE); #endif - while (!(fd == -1 && errno == EEXIST) && mktemp (template)); - else - fd = -1; - + } + while (fd == -1 && errno == EEXIST); #endif /* HAVE_MKSTEMP */ 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; @@ -1075,7 +1102,7 @@ tempfile (void) * 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; @@ -1083,12 +1110,53 @@ regular_file (unit_flags *flags) 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) @@ -1107,7 +1175,7 @@ regular_file (unit_flags *flags) break; default: - internal_error ("regular_file(): Bad action"); + internal_error (&opp->common, "regular_file(): Bad action"); } switch (flags->status) @@ -1126,30 +1194,30 @@ regular_file (unit_flags *flags) 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; */ -#ifdef HAVE_CRLF +#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 */ @@ -1158,11 +1226,11 @@ regular_file (unit_flags *flags) 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; @@ -1170,9 +1238,9 @@ regular_file (unit_flags *flags) if (fd >=0) { flags->action = ACTION_WRITE; - return fd; /* success */ + return fd; /* success */ } - return fd; /* failure */ + return fd; /* failure */ } @@ -1181,51 +1249,34 @@ regular_file (unit_flags *flags) * 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); } @@ -1235,7 +1286,7 @@ open_external (unit_flags *flags) stream * input_stream (void) { - return fd_to_stream (STDIN_FILENO, PROT_READ); + return fd_to_stream (STDIN_FILENO); } @@ -1245,7 +1296,14 @@ input_stream (void) 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; } @@ -1255,30 +1313,69 @@ output_stream (void) stream * error_stream (void) { - return fd_to_stream (STDERR_FILENO, PROT_WRITE); + stream * s; + +#if defined(HAVE_CRLF) && defined(HAVE_SETMODE) + setmode (STDERR_FILENO, O_BINARY); +#endif + + s = fd_to_stream (STDERR_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. */ -stream * -init_error_stream (void) +/* 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; } @@ -1290,9 +1387,13 @@ int compare_file_filename (gfc_unit *u, const char *name, int len) { char path[PATH_MAX + 1]; - struct stat st1; + gfstat_t st; #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)) @@ -1301,13 +1402,24 @@ compare_file_filename (gfc_unit *u, const char *name, int len) /* 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; #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); + return (st.st_dev == s->st_dev) && (st.st_ino == s->st_ino); #else + +# ifdef __MINGW32__ + /* We try to match files by a unique ID. On some filesystems (network + fs and FAT), we can't generate this unique ID, and will simply compare + filenames. */ + id1 = id_from_path (path); + id2 = id_from_fd (((unix_stream *) (u->s))->fd); + if (id1 || id2) + return (id1 == id2); +# endif + if (len != u->file_len) return 0; return (memcmp(path, u->file, len) == 0); @@ -1315,33 +1427,52 @@ compare_file_filename (gfc_unit *u, const char *name, int len) } +#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) { -#ifdef HAVE_WORKING_STAT - struct stat st2; -#endif gfc_unit *v; +#if defined(__MINGW32__) && !HAVE_WORKING_STAT + uint64_t id1; +#endif if (u == NULL) return NULL; #ifdef HAVE_WORKING_STAT - if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 && - st1->st_dev == st2.st_dev && st1->st_ino == st2.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 - if (compare_string(u->file_len, u->file, ioparm.file_len, ioparm.file) == 0) - return u; +# ifdef __MINGW32__ + if (u->s && ((id1 = id_from_fd (((unix_stream *) u->s)->fd)) || id1)) + { + if (id == id1) + return u; + } + else +# endif + if (compare_string (u->file_len, u->file, file_len, file) == 0) + return u; #endif - v = find_file0 (u->left, 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; @@ -1353,52 +1484,118 @@ find_file0 (gfc_unit * u, struct stat *st1) * 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); -} - - -/* stream_at_bof()-- Returns nonzero if the stream is at the beginning - * of the file. */ - -int -stream_at_bof (stream * s) -{ - unix_stream *us; +#if defined(__MINGW32__) && !HAVE_WORKING_STAT + id = id_from_path (path); +#endif - if (!is_seekable (s)) - return 0; + __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; + } - us = (unix_stream *) s; + 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; + } - return us->logical_offset == 0; + dec_waiting_unlocked (u); + } + return u; } +static gfc_unit * +flush_all_units_1 (gfc_unit *u, int min_unit) +{ + while (u != NULL) + { + if (u->unit_number > min_unit) + { + gfc_unit *r = flush_all_units_1 (u->left, min_unit); + if (r != NULL) + return r; + } + if (u->unit_number >= min_unit) + { + if (__gthread_mutex_trylock (&u->lock)) + return u; + if (u->s) + 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; - if (!is_seekable (s)) - return 0; + __gthread_mutex_lock (&unit_lock); + do + { + u = flush_all_units_1 (unit_root, min_unit); + if (u != NULL) + inc_waiting_locked (u); + __gthread_mutex_unlock (&unit_lock); + if (u == NULL) + return; - us = (unix_stream *) s; + __gthread_mutex_lock (&u->lock); - return us->logical_offset == us->dirty_offset; + 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); } @@ -1424,21 +1621,33 @@ delete_file (gfc_unit * u) * 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)) - return 0; - if (stat (path, &statbuf) < 0) + if (unpack_filename (path, file, file_len)) 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"; @@ -1450,7 +1659,7 @@ const char * 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) @@ -1458,7 +1667,7 @@ inquire_sequential (const char *string, int len) 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; @@ -1474,14 +1683,14 @@ const char * 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)) @@ -1498,7 +1707,7 @@ const char * 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) @@ -1507,7 +1716,7 @@ inquire_formatted (const char *string, int len) 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; @@ -1577,16 +1786,15 @@ inquire_readwrite (const char *string, int len) gfc_offset file_length (stream * s) { - return ((unix_stream *) s)->file_length; -} - - -/* file_position()-- Return the current position of the file */ - -gfc_offset -file_position (stream * s) -{ - return ((unix_stream *) s)->logical_offset; + gfc_offset curr, end; + if (!is_seekable (s)) + return -1; + curr = stell (s); + if (curr == -1) + return curr; + end = sseek (s, 0, SEEK_END); + sseek (s, curr, SEEK_SET); + return end; } @@ -1594,19 +1802,23 @@ file_position (stream * s) * it is not */ int -is_seekable (stream * s) +is_seekable (stream *s) { /* By convention, if file_length == -1, the file is not seekable. */ return ((unix_stream *) s)->file_length!=-1; } -try -flush (stream *s) + +/* is_special()-- Return nonzero if the stream is not a regular file. */ + +int +is_special (stream *s) { - return fd_flush( (unix_stream *) s); + return ((unix_stream *) s)->special_file; } + int stream_isatty (stream *s) { @@ -1614,14 +1826,18 @@ stream_isatty (stream *s) } char * +#ifdef HAVE_TTYNAME stream_ttyname (stream *s) { -#ifdef HAVE_TTYNAME return ttyname (((unix_stream *) s)->fd); +} #else +stream_ttyname (stream *s __attribute__ ((unused))) +{ return NULL; -#endif } +#endif + /* How files are stored: This is an operating-system specific issue, @@ -1644,13 +1860,13 @@ stream_ttyname (stream *s) 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