1 /* Copyright (C) 2002, 2003, 2004, 2005
2 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
7 Libgfortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 In addition to the permissions in the GNU General Public License, the
13 Free Software Foundation gives you unlimited permission to link the
14 compiled version of this file into combinations with other programs,
15 and to distribute those combinations without any restriction coming
16 from the use of this file. (The General Public License restrictions
17 do apply in other respects; for example, they cover modification of
18 the file, and distribution when not linked into a combine
21 Libgfortran is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License for more details.
26 You should have received a copy of the GNU General Public License
27 along with Libgfortran; see the file COPYING. If not, write to
28 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
29 Boston, MA 02110-1301, USA. */
31 /* Unix stream I/O module */
46 #include "libgfortran.h"
50 #define SSIZE_MAX SHRT_MAX
65 /* These flags aren't defined on all targets (mingw32), so provide them
83 /* This implementation of stream I/O is based on the paper:
85 * "Exploiting the advantages of mapped files for stream I/O",
86 * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
87 * USENIX conference", p. 27-42.
89 * It differs in a number of ways from the version described in the
90 * paper. First of all, threads are not an issue during I/O and we
91 * also don't have to worry about having multiple regions, since
92 * fortran's I/O model only allows you to be one place at a time.
94 * On the other hand, we have to be able to writing at the end of a
95 * stream, read from the start of a stream or read and write blocks of
96 * bytes from an arbitrary position. After opening a file, a pointer
97 * to a stream structure is returned, which is used to handle file
98 * accesses until the file is closed.
100 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
101 * pointer to a block of memory that mirror the file at position
102 * 'where' that is 'len' bytes long. The len integer is updated to
103 * reflect how many bytes were actually read. The only reason for a
104 * short read is end of file. The file pointer is updated. The
105 * pointer is valid until the next call to salloc_*.
107 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
108 * a pointer to a block of memory that is updated to reflect the state
109 * of the file. The length of the buffer is always equal to that
110 * requested. The buffer must be completely set by the caller. When
111 * data has been written, the sfree() function must be called to
112 * indicate that the caller is done writing data to the buffer. This
113 * may or may not cause a physical write.
115 * Short forms of these are salloc_r() and salloc_w() which drop the
116 * 'where' parameter and use the current file pointer. */
119 #define BUFFER_SIZE 8192
126 gfc_offset buffer_offset; /* File offset of the start of the buffer */
127 gfc_offset physical_offset; /* Current physical file offset */
128 gfc_offset logical_offset; /* Current logical file offset */
129 gfc_offset dirty_offset; /* Start of modified bytes in buffer */
130 gfc_offset file_length; /* Length of the file, -1 if not seekable. */
133 int len; /* Physical length of the current buffer */
134 int active; /* Length of valid bytes in the buffer */
137 int ndirty; /* Dirty bytes starting at dirty_offset */
139 int special_file; /* =1 if the fd refers to a special file */
141 unsigned unbuffered:1;
143 char small_buffer[BUFFER_SIZE];
148 /*move_pos_offset()-- Move the record pointer right or left
149 *relative to current position */
152 move_pos_offset (stream* st, int pos_off)
154 unix_stream * str = (unix_stream*)st;
157 str->logical_offset += pos_off;
159 if (str->dirty_offset + str->ndirty > str->logical_offset)
161 if (str->ndirty + pos_off > 0)
162 str->ndirty += pos_off;
165 str->dirty_offset += pos_off + pos_off;
176 /* fix_fd()-- Given a file descriptor, make sure it is not one of the
177 * standard descriptors, returning a non-standard descriptor. If the
178 * user specifies that system errors should go to standard output,
179 * then closes standard output, we don't want the system errors to a
180 * file that has been given file descriptor 1 or 0. We want to send
181 * the error to the invalid descriptor. */
186 int input, output, error;
188 input = output = error = 0;
190 /* Unix allocates the lowest descriptors first, so a loop is not
191 required, but this order is. */
193 if (fd == STDIN_FILENO)
198 if (fd == STDOUT_FILENO)
203 if (fd == STDERR_FILENO)
210 close (STDIN_FILENO);
212 close (STDOUT_FILENO);
214 close (STDERR_FILENO);
220 is_preconnected (stream * s)
224 fd = ((unix_stream *) s)->fd;
225 if (fd == STDIN_FILENO || fd == STDOUT_FILENO || fd == STDERR_FILENO)
232 /* Reset a stream after reading/writing. Assumes that the buffers have
236 reset_stream (unix_stream * s, size_t bytes_rw)
238 s->physical_offset += bytes_rw;
239 s->logical_offset = s->physical_offset;
240 if (s->file_length != -1 && s->physical_offset > s->file_length)
241 s->file_length = s->physical_offset;
245 /* Read bytes into a buffer, allowing for short reads. If the nbytes
246 * argument is less on return than on entry, it is because we've hit
247 * the end of file. */
250 do_read (unix_stream * s, void * buf, size_t * nbytes)
258 bytes_left = *nbytes;
259 buf_st = (char *) buf;
261 /* We must read in a loop since some systems don't restart system
262 calls in case of a signal. */
263 while (bytes_left > 0)
265 /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
266 so we must read in chunks smaller than SSIZE_MAX. */
267 trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
268 trans = read (s->fd, buf_st, trans);
279 else if (trans == 0) /* We hit EOF. */
285 *nbytes -= bytes_left;
290 /* Write a buffer to a stream, allowing for short writes. */
293 do_write (unix_stream * s, const void * buf, size_t * nbytes)
301 bytes_left = *nbytes;
302 buf_st = (char *) buf;
304 /* We must write in a loop since some systems don't restart system
305 calls in case of a signal. */
306 while (bytes_left > 0)
308 /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
309 so we must write in chunks smaller than SSIZE_MAX. */
310 trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
311 trans = write (s->fd, buf_st, trans);
326 *nbytes -= bytes_left;
331 /* get_oserror()-- Get the most recent operating system error. For
332 * unix, this is errno. */
337 return strerror (errno);
341 /* sys_exit()-- Terminate the program with an exit code */
350 /*********************************************************************
351 File descriptor stream functions
352 *********************************************************************/
355 /* fd_flush()-- Write bytes that need to be written */
358 fd_flush (unix_stream * s)
365 if (s->physical_offset != s->dirty_offset &&
366 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
369 writelen = s->ndirty;
370 if (do_write (s, s->buffer + (s->dirty_offset - s->buffer_offset),
374 s->physical_offset = s->dirty_offset + writelen;
376 /* don't increment file_length if the file is non-seekable */
377 if (s->file_length != -1 && s->physical_offset > s->file_length)
378 s->file_length = s->physical_offset;
380 s->ndirty -= writelen;
388 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
389 * satisfied. This subroutine gets the buffer ready for whatever is
393 fd_alloc (unix_stream * s, gfc_offset where,
394 int *len __attribute__ ((unused)))
399 if (*len <= BUFFER_SIZE)
401 new_buffer = s->small_buffer;
402 read_len = BUFFER_SIZE;
406 new_buffer = get_mem (*len);
410 /* Salvage bytes currently within the buffer. This is important for
411 * devices that cannot seek. */
413 if (s->buffer != NULL && s->buffer_offset <= where &&
414 where <= s->buffer_offset + s->active)
417 n = s->active - (where - s->buffer_offset);
418 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
423 { /* new buffer starts off empty */
427 s->buffer_offset = where;
429 /* free the old buffer if necessary */
431 if (s->buffer != NULL && s->buffer != s->small_buffer)
432 free_mem (s->buffer);
434 s->buffer = new_buffer;
439 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
440 * we've already buffered the data or we need to load it. Returns
441 * NULL on I/O error. */
444 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
449 where = s->logical_offset;
451 if (s->buffer != NULL && s->buffer_offset <= where &&
452 where + *len <= s->buffer_offset + s->active)
455 /* Return a position within the current buffer */
457 s->logical_offset = where + *len;
458 return s->buffer + where - s->buffer_offset;
461 fd_alloc (s, where, len);
463 m = where + s->active;
465 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
468 /* do_read() hangs on read from terminals for *BSD-systems. Only
469 use read() in that case. */
475 n = read (s->fd, s->buffer + s->active, s->len - s->active);
479 s->physical_offset = where + n;
486 n = s->len - s->active;
487 if (do_read (s, s->buffer + s->active, &n) != 0)
490 s->physical_offset = where + n;
494 if (s->active < *len)
495 *len = s->active; /* Bytes actually available */
497 s->logical_offset = where + *len;
503 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
504 * we've already buffered the data or we need to load it. */
507 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
512 where = s->logical_offset;
514 if (s->buffer == NULL || s->buffer_offset > where ||
515 where + *len > s->buffer_offset + s->len)
518 if (fd_flush (s) == FAILURE)
520 fd_alloc (s, where, len);
523 /* Return a position within the current buffer */
525 || where > s->dirty_offset + s->ndirty
526 || s->dirty_offset > where + *len)
527 { /* Discontiguous blocks, start with a clean buffer. */
528 /* Flush the buffer. */
531 s->dirty_offset = where;
536 gfc_offset start; /* Merge with the existing data. */
537 if (where < s->dirty_offset)
540 start = s->dirty_offset;
541 if (where + *len > s->dirty_offset + s->ndirty)
542 s->ndirty = where + *len - start;
544 s->ndirty = s->dirty_offset + s->ndirty - start;
545 s->dirty_offset = start;
548 s->logical_offset = where + *len;
550 if (where + *len > s->file_length)
551 s->file_length = where + *len;
553 n = s->logical_offset - s->buffer_offset;
557 return s->buffer + where - s->buffer_offset;
562 fd_sfree (unix_stream * s)
564 if (s->ndirty != 0 &&
565 (s->buffer != s->small_buffer || options.all_unbuffered ||
574 fd_seek (unix_stream * s, gfc_offset offset)
576 if (s->physical_offset == offset) /* Are we lucky and avoid syscall? */
578 s->logical_offset = offset;
582 s->physical_offset = s->logical_offset = offset;
584 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
588 /* truncate_file()-- Given a unit, truncate the file at the current
589 * position. Sets the physical location to the new end of the file.
590 * Returns nonzero on error. */
593 fd_truncate (unix_stream * s)
595 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
598 /* non-seekable files, like terminals and fifo's fail the lseek.
599 Using ftruncate on a seekable special file (like /dev/null)
600 is undefined, so we treat it as if the ftruncate failed.
602 #ifdef HAVE_FTRUNCATE
603 if (s->special_file || ftruncate (s->fd, s->logical_offset))
606 if (s->special_file || chsize (s->fd, s->logical_offset))
610 s->physical_offset = s->file_length = 0;
614 s->physical_offset = s->file_length = s->logical_offset;
622 /* Stream read function. Avoids using a buffer for big reads. The
623 interface is like POSIX read(), but the nbytes argument is a
624 pointer; on return it contains the number of bytes written. The
625 function return value is the status indicator (0 for success). */
628 fd_read (unix_stream * s, void * buf, size_t * nbytes)
633 if (*nbytes < BUFFER_SIZE && !s->unbuffered)
636 p = fd_alloc_r_at (s, &tmp, -1);
640 memcpy (buf, p, *nbytes);
650 /* If the request is bigger than BUFFER_SIZE we flush the buffers
651 and read directly. */
652 if (fd_flush (s) == FAILURE)
658 if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
664 status = do_read (s, buf, nbytes);
665 reset_stream (s, *nbytes);
670 /* Stream write function. Avoids using a buffer for big writes. The
671 interface is like POSIX write(), but the nbytes argument is a
672 pointer; on return it contains the number of bytes written. The
673 function return value is the status indicator (0 for success). */
676 fd_write (unix_stream * s, const void * buf, size_t * nbytes)
681 if (*nbytes < BUFFER_SIZE && !s->unbuffered)
684 p = fd_alloc_w_at (s, &tmp, -1);
688 memcpy (p, buf, *nbytes);
698 /* If the request is bigger than BUFFER_SIZE we flush the buffers
699 and write directly. */
700 if (fd_flush (s) == FAILURE)
706 if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
712 status = do_write (s, buf, nbytes);
713 reset_stream (s, *nbytes);
719 fd_close (unix_stream * s)
721 if (fd_flush (s) == FAILURE)
724 if (s->buffer != NULL && s->buffer != s->small_buffer)
725 free_mem (s->buffer);
727 if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
729 if (close (s->fd) < 0)
740 fd_open (unix_stream * s)
745 s->st.alloc_r_at = (void *) fd_alloc_r_at;
746 s->st.alloc_w_at = (void *) fd_alloc_w_at;
747 s->st.sfree = (void *) fd_sfree;
748 s->st.close = (void *) fd_close;
749 s->st.seek = (void *) fd_seek;
750 s->st.truncate = (void *) fd_truncate;
751 s->st.read = (void *) fd_read;
752 s->st.write = (void *) fd_write;
760 /*********************************************************************
761 memory stream functions - These are used for internal files
763 The idea here is that a single stream structure is created and all
764 requests must be satisfied from it. The location and size of the
765 buffer is the character variable supplied to the READ or WRITE
768 *********************************************************************/
772 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
777 where = s->logical_offset;
779 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
782 s->logical_offset = where + *len;
784 n = s->buffer_offset + s->active - where;
788 return s->buffer + (where - s->buffer_offset);
793 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
797 assert (*len >= 0); /* Negative values not allowed. */
800 where = s->logical_offset;
804 if (where < s->buffer_offset)
807 if (m > s->file_length)
810 s->logical_offset = m;
812 return s->buffer + (where - s->buffer_offset);
816 /* Stream read function for internal units. This is not actually used
817 at the moment, as all internal IO is formatted and the formatted IO
818 routines use mem_alloc_r_at. */
821 mem_read (unix_stream * s, void * buf, size_t * nbytes)
827 p = mem_alloc_r_at (s, &tmp, -1);
831 memcpy (buf, p, *nbytes);
842 /* Stream write function for internal units. This is not actually used
843 at the moment, as all internal IO is formatted and the formatted IO
844 routines use mem_alloc_w_at. */
847 mem_write (unix_stream * s, const void * buf, size_t * nbytes)
855 p = mem_alloc_w_at (s, &tmp, -1);
859 memcpy (p, buf, *nbytes);
871 mem_seek (unix_stream * s, gfc_offset offset)
873 if (offset > s->file_length)
879 s->logical_offset = offset;
885 mem_truncate (unix_stream * s __attribute__ ((unused)))
892 mem_close (unix_stream * s)
901 mem_sfree (unix_stream * s __attribute__ ((unused)))
908 /*********************************************************************
909 Public functions -- A reimplementation of this module needs to
910 define functional equivalents of the following.
911 *********************************************************************/
913 /* empty_internal_buffer()-- Zero the buffer of Internal file */
916 empty_internal_buffer(stream *strm)
918 unix_stream * s = (unix_stream *) strm;
919 memset(s->buffer, ' ', s->file_length);
922 /* open_internal()-- Returns a stream structure from an internal file */
925 open_internal (char *base, int length)
929 s = get_mem (sizeof (unix_stream));
930 memset (s, '\0', sizeof (unix_stream));
933 s->buffer_offset = 0;
935 s->logical_offset = 0;
936 s->active = s->file_length = length;
938 s->st.alloc_r_at = (void *) mem_alloc_r_at;
939 s->st.alloc_w_at = (void *) mem_alloc_w_at;
940 s->st.sfree = (void *) mem_sfree;
941 s->st.close = (void *) mem_close;
942 s->st.seek = (void *) mem_seek;
943 s->st.truncate = (void *) mem_truncate;
944 s->st.read = (void *) mem_read;
945 s->st.write = (void *) mem_write;
951 /* fd_to_stream()-- Given an open file descriptor, build a stream
955 fd_to_stream (int fd, int prot)
960 s = get_mem (sizeof (unix_stream));
961 memset (s, '\0', sizeof (unix_stream));
964 s->buffer_offset = 0;
965 s->physical_offset = 0;
966 s->logical_offset = 0;
969 /* Get the current length of the file. */
971 fstat (fd, &statbuf);
972 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
973 s->special_file = !S_ISREG (statbuf.st_mode);
981 /* Given the Fortran unit number, convert it to a C file descriptor. */
988 us = find_unit(unit);
992 return ((unix_stream *) us->s)->fd;
996 /* unpack_filename()-- Given a fortran string and a pointer to a
997 * buffer that is PATH_MAX characters, convert the fortran string to a
998 * C string in the buffer. Returns nonzero if this is not possible. */
1001 unpack_filename (char *cstring, const char *fstring, int len)
1003 len = fstrlen (fstring, len);
1004 if (len >= PATH_MAX)
1007 memmove (cstring, fstring, len);
1008 cstring[len] = '\0';
1014 /* tempfile()-- Generate a temporary filename for a scratch file and
1015 * open it. mkstemp() opens the file for reading and writing, but the
1016 * library mode prevents anything that is not allowed. The descriptor
1017 * is returned, which is -1 on error. The template is pointed to by
1018 * ioparm.file, which is copied into the unit structure
1019 * and freed later. */
1024 const char *tempdir;
1028 tempdir = getenv ("GFORTRAN_TMPDIR");
1029 if (tempdir == NULL)
1030 tempdir = getenv ("TMP");
1031 if (tempdir == NULL)
1032 tempdir = getenv ("TEMP");
1033 if (tempdir == NULL)
1034 tempdir = DEFAULT_TEMPDIR;
1036 template = get_mem (strlen (tempdir) + 20);
1038 st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
1042 fd = mkstemp (template);
1044 #else /* HAVE_MKSTEMP */
1046 if (mktemp (template))
1049 fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY,
1050 S_IREAD | S_IWRITE);
1052 fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
1054 while (!(fd == -1 && errno == EEXIST) && mktemp (template));
1058 #endif /* HAVE_MKSTEMP */
1061 free_mem (template);
1064 ioparm.file = template;
1065 ioparm.file_len = strlen (template); /* Don't include trailing nul */
1072 /* regular_file()-- Open a regular file.
1073 * Change flags->action if it is ACTION_UNSPECIFIED on entry,
1074 * unless an error occurs.
1075 * Returns the descriptor, which is less than zero on error. */
1078 regular_file (unit_flags *flags)
1080 char path[PATH_MAX + 1];
1086 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1088 errno = ENOENT; /* Fake an OS error */
1094 switch (flags->action)
1104 case ACTION_READWRITE:
1105 case ACTION_UNSPECIFIED:
1110 internal_error ("regular_file(): Bad action");
1113 switch (flags->status)
1116 crflag = O_CREAT | O_EXCL;
1119 case STATUS_OLD: /* open will fail if the file does not exist*/
1123 case STATUS_UNKNOWN:
1124 case STATUS_SCRATCH:
1128 case STATUS_REPLACE:
1129 crflag = O_CREAT | O_TRUNC;
1133 internal_error ("regular_file(): Bad status");
1136 /* rwflag |= O_LARGEFILE; */
1142 mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
1143 fd = open (path, rwflag | crflag, mode);
1144 if (flags->action != ACTION_UNSPECIFIED)
1149 flags->action = ACTION_READWRITE;
1152 if (errno != EACCES)
1155 /* retry for read-only access */
1157 fd = open (path, rwflag | crflag, mode);
1160 flags->action = ACTION_READ;
1161 return fd; /* success */
1164 if (errno != EACCES)
1165 return fd; /* failure */
1167 /* retry for write-only access */
1169 fd = open (path, rwflag | crflag, mode);
1172 flags->action = ACTION_WRITE;
1173 return fd; /* success */
1175 return fd; /* failure */
1179 /* open_external()-- Open an external file, unix specific version.
1180 * Change flags->action if it is ACTION_UNSPECIFIED on entry.
1181 * Returns NULL on operating system error. */
1184 open_external (unit_flags *flags)
1188 if (flags->status == STATUS_SCRATCH)
1191 if (flags->action == ACTION_UNSPECIFIED)
1192 flags->action = ACTION_READWRITE;
1194 #if HAVE_UNLINK_OPEN_FILE
1195 /* We can unlink scratch files now and it will go away when closed. */
1196 unlink (ioparm.file);
1201 /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
1203 fd = regular_file (flags);
1210 switch (flags->action)
1220 case ACTION_READWRITE:
1221 prot = PROT_READ | PROT_WRITE;
1225 internal_error ("open_external(): Bad action");
1228 return fd_to_stream (fd, prot);
1232 /* input_stream()-- Return a stream pointer to the default input stream.
1233 * Called on initialization. */
1238 return fd_to_stream (STDIN_FILENO, PROT_READ);
1242 /* output_stream()-- Return a stream pointer to the default output stream.
1243 * Called on initialization. */
1246 output_stream (void)
1248 return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
1252 /* error_stream()-- Return a stream pointer to the default error stream.
1253 * Called on initialization. */
1258 return fd_to_stream (STDERR_FILENO, PROT_WRITE);
1261 /* init_error_stream()-- Return a pointer to the error stream. This
1262 * subroutine is called when the stream is needed, rather than at
1263 * initialization. We want to work even if memory has been seriously
1267 init_error_stream (void)
1269 static unix_stream error;
1271 memset (&error, '\0', sizeof (error));
1273 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1275 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1276 error.st.sfree = (void *) fd_sfree;
1278 error.unbuffered = 1;
1279 error.buffer = error.small_buffer;
1281 return (stream *) & error;
1285 /* compare_file_filename()-- Given an open stream and a fortran string
1286 * that is a filename, figure out if the file is the same as the
1290 compare_file_filename (gfc_unit *u, const char *name, int len)
1292 char path[PATH_MAX + 1];
1294 #ifdef HAVE_WORKING_STAT
1298 if (unpack_filename (path, name, len))
1299 return 0; /* Can't be the same */
1301 /* If the filename doesn't exist, then there is no match with the
1304 if (stat (path, &st1) < 0)
1307 #ifdef HAVE_WORKING_STAT
1308 fstat (((unix_stream *) (u->s))->fd, &st2);
1309 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1311 if (len != u->file_len)
1313 return (memcmp(path, u->file, len) == 0);
1318 /* find_file0()-- Recursive work function for find_file() */
1321 find_file0 (gfc_unit * u, struct stat *st1)
1323 #ifdef HAVE_WORKING_STAT
1331 #ifdef HAVE_WORKING_STAT
1332 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1333 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1336 if (compare_string(u->file_len, u->file, ioparm.file_len, ioparm.file) == 0)
1340 v = find_file0 (u->left, st1);
1344 v = find_file0 (u->right, st1);
1352 /* find_file()-- Take the current filename and see if there is a unit
1353 * that has the file already open. Returns a pointer to the unit if so. */
1358 char path[PATH_MAX + 1];
1359 struct stat statbuf;
1361 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1364 if (stat (path, &statbuf) < 0)
1367 return find_file0 (g.unit_root, &statbuf);
1371 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1375 stream_at_bof (stream * s)
1379 if (!is_seekable (s))
1382 us = (unix_stream *) s;
1384 return us->logical_offset == 0;
1388 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1392 stream_at_eof (stream * s)
1396 if (!is_seekable (s))
1399 us = (unix_stream *) s;
1401 return us->logical_offset == us->dirty_offset;
1405 /* delete_file()-- Given a unit structure, delete the file associated
1406 * with the unit. Returns nonzero if something went wrong. */
1409 delete_file (gfc_unit * u)
1411 char path[PATH_MAX + 1];
1413 if (unpack_filename (path, u->file, u->file_len))
1414 { /* Shouldn't be possible */
1419 return unlink (path);
1423 /* file_exists()-- Returns nonzero if the current filename exists on
1429 char path[PATH_MAX + 1];
1430 struct stat statbuf;
1432 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1435 if (stat (path, &statbuf) < 0)
1443 static const char yes[] = "YES", no[] = "NO", unknown[] = "UNKNOWN";
1445 /* inquire_sequential()-- Given a fortran string, determine if the
1446 * file is suitable for sequential access. Returns a C-style
1450 inquire_sequential (const char *string, int len)
1452 char path[PATH_MAX + 1];
1453 struct stat statbuf;
1455 if (string == NULL ||
1456 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1459 if (S_ISREG (statbuf.st_mode) ||
1460 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1463 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1470 /* inquire_direct()-- Given a fortran string, determine if the file is
1471 * suitable for direct access. Returns a C-style string. */
1474 inquire_direct (const char *string, int len)
1476 char path[PATH_MAX + 1];
1477 struct stat statbuf;
1479 if (string == NULL ||
1480 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1483 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1486 if (S_ISDIR (statbuf.st_mode) ||
1487 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1494 /* inquire_formatted()-- Given a fortran string, determine if the file
1495 * is suitable for formatted form. Returns a C-style string. */
1498 inquire_formatted (const char *string, int len)
1500 char path[PATH_MAX + 1];
1501 struct stat statbuf;
1503 if (string == NULL ||
1504 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1507 if (S_ISREG (statbuf.st_mode) ||
1508 S_ISBLK (statbuf.st_mode) ||
1509 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1512 if (S_ISDIR (statbuf.st_mode))
1519 /* inquire_unformatted()-- Given a fortran string, determine if the file
1520 * is suitable for unformatted form. Returns a C-style string. */
1523 inquire_unformatted (const char *string, int len)
1525 return inquire_formatted (string, len);
1529 /* inquire_access()-- Given a fortran string, determine if the file is
1530 * suitable for access. */
1533 inquire_access (const char *string, int len, int mode)
1535 char path[PATH_MAX + 1];
1537 if (string == NULL || unpack_filename (path, string, len) ||
1538 access (path, mode) < 0)
1545 /* inquire_read()-- Given a fortran string, determine if the file is
1546 * suitable for READ access. */
1549 inquire_read (const char *string, int len)
1551 return inquire_access (string, len, R_OK);
1555 /* inquire_write()-- Given a fortran string, determine if the file is
1556 * suitable for READ access. */
1559 inquire_write (const char *string, int len)
1561 return inquire_access (string, len, W_OK);
1565 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1566 * suitable for read and write access. */
1569 inquire_readwrite (const char *string, int len)
1571 return inquire_access (string, len, R_OK | W_OK);
1575 /* file_length()-- Return the file length in bytes, -1 if unknown */
1578 file_length (stream * s)
1580 return ((unix_stream *) s)->file_length;
1584 /* file_position()-- Return the current position of the file */
1587 file_position (stream * s)
1589 return ((unix_stream *) s)->logical_offset;
1593 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1597 is_seekable (stream * s)
1599 /* By convention, if file_length == -1, the file is not
1601 return ((unix_stream *) s)->file_length!=-1;
1607 return fd_flush( (unix_stream *) s);
1611 stream_isatty (stream *s)
1613 return isatty (((unix_stream *) s)->fd);
1617 stream_ttyname (stream *s)
1620 return ttyname (((unix_stream *) s)->fd);
1627 /* How files are stored: This is an operating-system specific issue,
1628 and therefore belongs here. There are three cases to consider.
1631 Records are written as block of bytes corresponding to the record
1632 length of the file. This goes for both formatted and unformatted
1633 records. Positioning is done explicitly for each data transfer,
1634 so positioning is not much of an issue.
1636 Sequential Formatted:
1637 Records are separated by newline characters. The newline character
1638 is prohibited from appearing in a string. If it does, this will be
1639 messed up on the next read. End of file is also the end of a record.
1641 Sequential Unformatted:
1642 In this case, we are merely copying bytes to and from main storage,
1643 yet we need to keep track of varying record lengths. We adopt
1644 the solution used by f2c. Each record contains a pair of length
1647 Length of record n in bytes
1649 Length of record n in bytes
1651 Length of record n+1 in bytes
1653 Length of record n+1 in bytes
1655 The length is stored at the end of a record to allow backspacing to the
1656 previous record. Between data transfer statements, the file pointer
1657 is left pointing to the first length of the current record.
1659 ENDFILE records are never explicitly stored.