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, 59 Temple Place - Suite 330,
29 Boston, MA 02111-1307, USA. */
31 /* Unix stream I/O module */
42 #ifdef HAVE_SYS_MMAN_H
48 #include "libgfortran.h"
56 #define MAP_FAILED ((void *) -1)
67 /* These flags aren't defined on all targets (mingw32), so provide them
85 /* This implementation of stream I/O is based on the paper:
87 * "Exploiting the advantages of mapped files for stream I/O",
88 * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
89 * USENIX conference", p. 27-42.
91 * It differs in a number of ways from the version described in the
92 * paper. First of all, threads are not an issue during I/O and we
93 * also don't have to worry about having multiple regions, since
94 * fortran's I/O model only allows you to be one place at a time.
96 * On the other hand, we have to be able to writing at the end of a
97 * stream, read from the start of a stream or read and write blocks of
98 * bytes from an arbitrary position. After opening a file, a pointer
99 * to a stream structure is returned, which is used to handle file
100 * accesses until the file is closed.
102 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
103 * pointer to a block of memory that mirror the file at position
104 * 'where' that is 'len' bytes long. The len integer is updated to
105 * reflect how many bytes were actually read. The only reason for a
106 * short read is end of file. The file pointer is updated. The
107 * pointer is valid until the next call to salloc_*.
109 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
110 * a pointer to a block of memory that is updated to reflect the state
111 * of the file. The length of the buffer is always equal to that
112 * requested. The buffer must be completely set by the caller. When
113 * data has been written, the sfree() function must be called to
114 * indicate that the caller is done writing data to the buffer. This
115 * may or may not cause a physical write.
117 * Short forms of these are salloc_r() and salloc_w() which drop the
118 * 'where' parameter and use the current file pointer. */
121 #define BUFFER_SIZE 8192
128 gfc_offset buffer_offset; /* File offset of the start of the buffer */
129 gfc_offset physical_offset; /* Current physical file offset */
130 gfc_offset logical_offset; /* Current logical file offset */
131 gfc_offset dirty_offset; /* Start of modified bytes in buffer */
132 gfc_offset file_length; /* Length of the file, -1 if not seekable. */
135 int len; /* Physical length of the current buffer */
136 int active; /* Length of valid bytes in the buffer */
139 int ndirty; /* Dirty bytes starting at dirty_offset */
141 unsigned unbuffered:1, mmaped: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 /* write()-- Write a buffer to a descriptor, allowing for short writes */
223 writen (int fd, char *buffer, int len)
231 n = write (fd, buffer, len);
244 /* readn()-- Read bytes into a buffer, allowing for short reads. If
245 * fewer than len bytes are returned, it is because we've hit the end
249 readn (int fd, char *buffer, int len)
257 n = read (fd, buffer, len);
274 /* get_oserror()-- Get the most recent operating system error. For
275 * unix, this is errno. */
280 return strerror (errno);
284 /* sys_exit()-- Terminate the program with an exit code */
293 /*********************************************************************
294 File descriptor stream functions
295 *********************************************************************/
297 /* fd_flush()-- Write bytes that need to be written */
300 fd_flush (unix_stream * s)
305 if (s->physical_offset != s->dirty_offset &&
306 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
309 if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
313 s->physical_offset = s->dirty_offset + s->ndirty;
315 /* don't increment file_length if the file is non-seekable */
316 if (s->file_length != -1 && s->physical_offset > s->file_length)
317 s->file_length = s->physical_offset;
324 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
325 * satisfied. This subroutine gets the buffer ready for whatever is
329 fd_alloc (unix_stream * s, gfc_offset where,
330 int *len __attribute__ ((unused)))
335 if (*len <= BUFFER_SIZE)
337 new_buffer = s->small_buffer;
338 read_len = BUFFER_SIZE;
342 new_buffer = get_mem (*len);
346 /* Salvage bytes currently within the buffer. This is important for
347 * devices that cannot seek. */
349 if (s->buffer != NULL && s->buffer_offset <= where &&
350 where <= s->buffer_offset + s->active)
353 n = s->active - (where - s->buffer_offset);
354 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
359 { /* new buffer starts off empty */
363 s->buffer_offset = where;
365 /* free the old buffer if necessary */
367 if (s->buffer != NULL && s->buffer != s->small_buffer)
368 free_mem (s->buffer);
370 s->buffer = new_buffer;
376 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
377 * we've already buffered the data or we need to load it. Returns
378 * NULL on I/O error. */
381 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
387 where = s->logical_offset;
389 if (s->buffer != NULL && s->buffer_offset <= where &&
390 where + *len <= s->buffer_offset + s->active)
393 /* Return a position within the current buffer */
395 s->logical_offset = where + *len;
396 return s->buffer + where - s->buffer_offset;
399 fd_alloc (s, where, len);
401 m = where + s->active;
403 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
406 n = read (s->fd, s->buffer + s->active, s->len - s->active);
410 s->physical_offset = where + n;
413 if (s->active < *len)
414 *len = s->active; /* Bytes actually available */
416 s->logical_offset = where + *len;
422 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
423 * we've already buffered the data or we need to load it. */
426 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
431 where = s->logical_offset;
433 if (s->buffer == NULL || s->buffer_offset > where ||
434 where + *len > s->buffer_offset + s->len)
437 if (fd_flush (s) == FAILURE)
439 fd_alloc (s, where, len);
442 /* Return a position within the current buffer */
444 || where > s->dirty_offset + s->ndirty
445 || s->dirty_offset > where + *len)
446 { /* Discontiguous blocks, start with a clean buffer. */
447 /* Flush the buffer. */
450 s->dirty_offset = where;
455 gfc_offset start; /* Merge with the existing data. */
456 if (where < s->dirty_offset)
459 start = s->dirty_offset;
460 if (where + *len > s->dirty_offset + s->ndirty)
461 s->ndirty = where + *len - start;
463 s->ndirty = s->dirty_offset + s->ndirty - start;
464 s->dirty_offset = start;
467 s->logical_offset = where + *len;
469 if (where + *len > s->file_length)
470 s->file_length = where + *len;
472 n = s->logical_offset - s->buffer_offset;
476 return s->buffer + where - s->buffer_offset;
481 fd_sfree (unix_stream * s)
483 if (s->ndirty != 0 &&
484 (s->buffer != s->small_buffer || options.all_unbuffered ||
493 fd_seek (unix_stream * s, gfc_offset offset)
495 s->physical_offset = s->logical_offset = offset;
497 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
501 /* truncate_file()-- Given a unit, truncate the file at the current
502 * position. Sets the physical location to the new end of the file.
503 * Returns nonzero on error. */
506 fd_truncate (unix_stream * s)
508 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
511 /* non-seekable files, like terminals and fifo's fail the lseek.
512 the fd is a regular file at this point */
514 #ifdef HAVE_FTRUNCATE
515 if (ftruncate (s->fd, s->logical_offset))
518 if (chsize (s->fd, s->logical_offset))
522 s->physical_offset = s->file_length = 0;
526 s->physical_offset = s->file_length = s->logical_offset;
533 fd_close (unix_stream * s)
535 if (fd_flush (s) == FAILURE)
538 if (s->buffer != NULL && s->buffer != s->small_buffer)
539 free_mem (s->buffer);
541 if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
543 if (close (s->fd) < 0)
554 fd_open (unix_stream * s)
559 s->st.alloc_r_at = (void *) fd_alloc_r_at;
560 s->st.alloc_w_at = (void *) fd_alloc_w_at;
561 s->st.sfree = (void *) fd_sfree;
562 s->st.close = (void *) fd_close;
563 s->st.seek = (void *) fd_seek;
564 s->st.truncate = (void *) fd_truncate;
570 /*********************************************************************
571 mmap stream functions
573 Because mmap() is not capable of extending a file, we have to keep
574 track of how long the file is. We also have to be able to detect end
575 of file conditions. If there are multiple writers to the file (which
576 can only happen outside the current program), things will get
577 confused. Then again, things will get confused anyway.
579 *********************************************************************/
583 static int page_size, page_mask;
585 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
588 mmap_flush (unix_stream * s)
593 if (s->buffer == NULL)
596 if (munmap (s->buffer, s->active))
606 /* mmap_alloc()-- mmap() a section of the file. The whole section is
607 * guaranteed to be mappable. */
610 mmap_alloc (unix_stream * s, gfc_offset where,
611 int *len __attribute__ ((unused)))
617 if (mmap_flush (s) == FAILURE)
620 offset = where & page_mask; /* Round down to the next page */
622 length = ((where - offset) & page_mask) + 2 * page_size;
624 p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
625 if (p == (char *) MAP_FAILED)
630 s->buffer_offset = offset;
638 mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
643 where = s->logical_offset;
647 if ((s->buffer == NULL || s->buffer_offset > where ||
648 m > s->buffer_offset + s->active) &&
649 mmap_alloc (s, where, len) == FAILURE)
652 if (m > s->file_length)
654 *len = s->file_length - s->logical_offset;
655 s->logical_offset = s->file_length;
658 s->logical_offset = m;
660 return s->buffer + (where - s->buffer_offset);
665 mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
668 where = s->logical_offset;
670 /* If we're extending the file, we have to use file descriptor
673 if (where + *len > s->file_length)
677 return fd_alloc_w_at (s, len, where);
680 if ((s->buffer == NULL || s->buffer_offset > where ||
681 where + *len > s->buffer_offset + s->active ||
682 where < s->buffer_offset + s->active) &&
683 mmap_alloc (s, where, len) == FAILURE)
686 s->logical_offset = where + *len;
688 return s->buffer + where - s->buffer_offset;
693 mmap_seek (unix_stream * s, gfc_offset offset)
695 s->logical_offset = offset;
701 mmap_close (unix_stream * s)
707 if (close (s->fd) < 0)
716 mmap_sfree (unix_stream * s __attribute__ ((unused)))
722 /* mmap_open()-- mmap_specific open. If the particular file cannot be
723 * mmap()-ed, we fall back to the file descriptor functions. */
726 mmap_open (unix_stream * s __attribute__ ((unused)))
731 page_size = getpagesize ();
734 p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
735 if (p == (char *) MAP_FAILED)
741 munmap (p, page_size);
750 s->st.alloc_r_at = (void *) mmap_alloc_r_at;
751 s->st.alloc_w_at = (void *) mmap_alloc_w_at;
752 s->st.sfree = (void *) mmap_sfree;
753 s->st.close = (void *) mmap_close;
754 s->st.seek = (void *) mmap_seek;
755 s->st.truncate = (void *) fd_truncate;
757 if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
766 /*********************************************************************
767 memory stream functions - These are used for internal files
769 The idea here is that a single stream structure is created and all
770 requests must be satisfied from it. The location and size of the
771 buffer is the character variable supplied to the READ or WRITE
774 *********************************************************************/
778 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
783 where = s->logical_offset;
785 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
788 s->logical_offset = where + *len;
790 n = s->buffer_offset + s->active - where;
794 return s->buffer + (where - s->buffer_offset);
799 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
804 where = s->logical_offset;
808 if (where < s->buffer_offset || m > s->buffer_offset + s->active)
811 s->logical_offset = m;
813 return s->buffer + (where - s->buffer_offset);
818 mem_seek (unix_stream * s, gfc_offset offset)
820 if (offset > s->file_length)
826 s->logical_offset = offset;
832 mem_truncate (unix_stream * s __attribute__ ((unused)))
839 mem_close (unix_stream * s)
848 mem_sfree (unix_stream * s __attribute__ ((unused)))
855 /*********************************************************************
856 Public functions -- A reimplementation of this module needs to
857 define functional equivalents of the following.
858 *********************************************************************/
860 /* empty_internal_buffer()-- Zero the buffer of Internal file */
863 empty_internal_buffer(stream *strm)
865 unix_stream * s = (unix_stream *) strm;
866 memset(s->buffer, ' ', s->file_length);
869 /* open_internal()-- Returns a stream structure from an internal file */
872 open_internal (char *base, int length)
876 s = get_mem (sizeof (unix_stream));
877 memset (s, '\0', sizeof (unix_stream));
880 s->buffer_offset = 0;
882 s->logical_offset = 0;
883 s->active = s->file_length = length;
885 s->st.alloc_r_at = (void *) mem_alloc_r_at;
886 s->st.alloc_w_at = (void *) mem_alloc_w_at;
887 s->st.sfree = (void *) mem_sfree;
888 s->st.close = (void *) mem_close;
889 s->st.seek = (void *) mem_seek;
890 s->st.truncate = (void *) mem_truncate;
896 /* fd_to_stream()-- Given an open file descriptor, build a stream
900 fd_to_stream (int fd, int prot, int avoid_mmap)
905 s = get_mem (sizeof (unix_stream));
906 memset (s, '\0', sizeof (unix_stream));
909 s->buffer_offset = 0;
910 s->physical_offset = 0;
911 s->logical_offset = 0;
914 /* Get the current length of the file. */
916 fstat (fd, &statbuf);
917 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
932 /* Given the Fortran unit number, convert it to a C file descriptor. */
939 us = find_unit(unit);
943 return ((unix_stream *) us->s)->fd;
947 /* unpack_filename()-- Given a fortran string and a pointer to a
948 * buffer that is PATH_MAX characters, convert the fortran string to a
949 * C string in the buffer. Returns nonzero if this is not possible. */
952 unpack_filename (char *cstring, const char *fstring, int len)
954 len = fstrlen (fstring, len);
958 memmove (cstring, fstring, len);
965 /* tempfile()-- Generate a temporary filename for a scratch file and
966 * open it. mkstemp() opens the file for reading and writing, but the
967 * library mode prevents anything that is not allowed. The descriptor
968 * is returned, which is -1 on error. The template is pointed to by
969 * ioparm.file, which is copied into the unit structure
970 * and freed later. */
979 tempdir = getenv ("GFORTRAN_TMPDIR");
981 tempdir = getenv ("TMP");
983 tempdir = DEFAULT_TEMPDIR;
985 template = get_mem (strlen (tempdir) + 20);
987 st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
991 fd = mkstemp (template);
993 #else /* HAVE_MKSTEMP */
995 if (mktemp (template))
997 fd = open (template, O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
998 while (!(fd == -1 && errno == EEXIST) && mktemp (template));
1002 #endif /* HAVE_MKSTEMP */
1005 free_mem (template);
1008 ioparm.file = template;
1009 ioparm.file_len = strlen (template); /* Don't include trailing nul */
1016 /* regular_file()-- Open a regular file.
1017 * Change flags->action if it is ACTION_UNSPECIFIED on entry,
1018 * unless an error occurs.
1019 * Returns the descriptor, which is less than zero on error. */
1022 regular_file (unit_flags *flags)
1024 char path[PATH_MAX + 1];
1030 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1032 errno = ENOENT; /* Fake an OS error */
1038 switch (flags->action)
1048 case ACTION_READWRITE:
1049 case ACTION_UNSPECIFIED:
1054 internal_error ("regular_file(): Bad action");
1057 switch (flags->status)
1060 crflag = O_CREAT | O_EXCL;
1063 case STATUS_OLD: /* open will fail if the file does not exist*/
1067 case STATUS_UNKNOWN:
1068 case STATUS_SCRATCH:
1072 case STATUS_REPLACE:
1073 crflag = O_CREAT | O_TRUNC;
1077 internal_error ("regular_file(): Bad status");
1080 /* rwflag |= O_LARGEFILE; */
1082 mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
1083 fd = open (path, rwflag | crflag, mode);
1084 if (flags->action != ACTION_UNSPECIFIED)
1089 flags->action = ACTION_READWRITE;
1092 if (errno != EACCES)
1095 /* retry for read-only access */
1097 fd = open (path, rwflag | crflag, mode);
1100 flags->action = ACTION_READ;
1101 return fd; /* success */
1104 if (errno != EACCES)
1105 return fd; /* failure */
1107 /* retry for write-only access */
1109 fd = open (path, rwflag | crflag, mode);
1112 flags->action = ACTION_WRITE;
1113 return fd; /* success */
1115 return fd; /* failure */
1119 /* open_external()-- Open an external file, unix specific version.
1120 * Change flags->action if it is ACTION_UNSPECIFIED on entry.
1121 * Returns NULL on operating system error. */
1124 open_external (unit_flags *flags)
1128 if (flags->status == STATUS_SCRATCH)
1131 if (flags->action == ACTION_UNSPECIFIED)
1132 flags->action = ACTION_READWRITE;
1133 /* We can unlink scratch files now and it will go away when closed. */
1134 unlink (ioparm.file);
1138 /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
1140 fd = regular_file (flags);
1147 switch (flags->action)
1157 case ACTION_READWRITE:
1158 prot = PROT_READ | PROT_WRITE;
1162 internal_error ("open_external(): Bad action");
1165 return fd_to_stream (fd, prot, 0);
1169 /* input_stream()-- Return a stream pointer to the default input stream.
1170 * Called on initialization. */
1175 return fd_to_stream (STDIN_FILENO, PROT_READ, 1);
1179 /* output_stream()-- Return a stream pointer to the default output stream.
1180 * Called on initialization. */
1183 output_stream (void)
1185 return fd_to_stream (STDOUT_FILENO, PROT_WRITE, 1);
1189 /* error_stream()-- Return a stream pointer to the default error stream.
1190 * Called on initialization. */
1195 return fd_to_stream (STDERR_FILENO, PROT_WRITE, 1);
1198 /* init_error_stream()-- Return a pointer to the error stream. This
1199 * subroutine is called when the stream is needed, rather than at
1200 * initialization. We want to work even if memory has been seriously
1204 init_error_stream (void)
1206 static unix_stream error;
1208 memset (&error, '\0', sizeof (error));
1210 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1212 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1213 error.st.sfree = (void *) fd_sfree;
1215 error.unbuffered = 1;
1216 error.buffer = error.small_buffer;
1218 return (stream *) & error;
1222 /* compare_file_filename()-- Given an open stream and a fortran string
1223 * that is a filename, figure out if the file is the same as the
1227 compare_file_filename (stream * s, const char *name, int len)
1229 char path[PATH_MAX + 1];
1230 struct stat st1, st2;
1232 if (unpack_filename (path, name, len))
1233 return 0; /* Can't be the same */
1235 /* If the filename doesn't exist, then there is no match with the
1238 if (stat (path, &st1) < 0)
1241 fstat (((unix_stream *) s)->fd, &st2);
1243 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1247 /* find_file0()-- Recursive work function for find_file() */
1250 find_file0 (gfc_unit * u, struct stat *st1)
1258 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1259 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1262 v = find_file0 (u->left, st1);
1266 v = find_file0 (u->right, st1);
1274 /* find_file()-- Take the current filename and see if there is a unit
1275 * that has the file already open. Returns a pointer to the unit if so. */
1280 char path[PATH_MAX + 1];
1281 struct stat statbuf;
1283 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1286 if (stat (path, &statbuf) < 0)
1289 return find_file0 (g.unit_root, &statbuf);
1293 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1297 stream_at_bof (stream * s)
1301 if (!is_seekable (s))
1304 us = (unix_stream *) s;
1306 return us->logical_offset == 0;
1310 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1314 stream_at_eof (stream * s)
1318 if (!is_seekable (s))
1321 us = (unix_stream *) s;
1323 return us->logical_offset == us->dirty_offset;
1327 /* delete_file()-- Given a unit structure, delete the file associated
1328 * with the unit. Returns nonzero if something went wrong. */
1331 delete_file (gfc_unit * u)
1333 char path[PATH_MAX + 1];
1335 if (unpack_filename (path, u->file, u->file_len))
1336 { /* Shouldn't be possible */
1341 return unlink (path);
1345 /* file_exists()-- Returns nonzero if the current filename exists on
1351 char path[PATH_MAX + 1];
1352 struct stat statbuf;
1354 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1357 if (stat (path, &statbuf) < 0)
1365 static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
1367 /* inquire_sequential()-- Given a fortran string, determine if the
1368 * file is suitable for sequential access. Returns a C-style
1372 inquire_sequential (const char *string, int len)
1374 char path[PATH_MAX + 1];
1375 struct stat statbuf;
1377 if (string == NULL ||
1378 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1381 if (S_ISREG (statbuf.st_mode) ||
1382 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1385 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1392 /* inquire_direct()-- Given a fortran string, determine if the file is
1393 * suitable for direct access. Returns a C-style string. */
1396 inquire_direct (const char *string, int len)
1398 char path[PATH_MAX + 1];
1399 struct stat statbuf;
1401 if (string == NULL ||
1402 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1405 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1408 if (S_ISDIR (statbuf.st_mode) ||
1409 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1416 /* inquire_formatted()-- Given a fortran string, determine if the file
1417 * is suitable for formatted form. Returns a C-style string. */
1420 inquire_formatted (const char *string, int len)
1422 char path[PATH_MAX + 1];
1423 struct stat statbuf;
1425 if (string == NULL ||
1426 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1429 if (S_ISREG (statbuf.st_mode) ||
1430 S_ISBLK (statbuf.st_mode) ||
1431 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1434 if (S_ISDIR (statbuf.st_mode))
1441 /* inquire_unformatted()-- Given a fortran string, determine if the file
1442 * is suitable for unformatted form. Returns a C-style string. */
1445 inquire_unformatted (const char *string, int len)
1447 return inquire_formatted (string, len);
1451 /* inquire_access()-- Given a fortran string, determine if the file is
1452 * suitable for access. */
1455 inquire_access (const char *string, int len, int mode)
1457 char path[PATH_MAX + 1];
1459 if (string == NULL || unpack_filename (path, string, len) ||
1460 access (path, mode) < 0)
1467 /* inquire_read()-- Given a fortran string, determine if the file is
1468 * suitable for READ access. */
1471 inquire_read (const char *string, int len)
1473 return inquire_access (string, len, R_OK);
1477 /* inquire_write()-- Given a fortran string, determine if the file is
1478 * suitable for READ access. */
1481 inquire_write (const char *string, int len)
1483 return inquire_access (string, len, W_OK);
1487 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1488 * suitable for read and write access. */
1491 inquire_readwrite (const char *string, int len)
1493 return inquire_access (string, len, R_OK | W_OK);
1497 /* file_length()-- Return the file length in bytes, -1 if unknown */
1500 file_length (stream * s)
1502 return ((unix_stream *) s)->file_length;
1506 /* file_position()-- Return the current position of the file */
1509 file_position (stream * s)
1511 return ((unix_stream *) s)->logical_offset;
1515 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1519 is_seekable (stream * s)
1521 /* by convention, if file_length == -1, the file is not seekable
1522 note that a mmapped file is always seekable, an fd_ file may
1524 return ((unix_stream *) s)->file_length!=-1;
1530 return fd_flush( (unix_stream *) s);
1534 /* How files are stored: This is an operating-system specific issue,
1535 and therefore belongs here. There are three cases to consider.
1538 Records are written as block of bytes corresponding to the record
1539 length of the file. This goes for both formatted and unformatted
1540 records. Positioning is done explicitly for each data transfer,
1541 so positioning is not much of an issue.
1543 Sequential Formatted:
1544 Records are separated by newline characters. The newline character
1545 is prohibited from appearing in a string. If it does, this will be
1546 messed up on the next read. End of file is also the end of a record.
1548 Sequential Unformatted:
1549 In this case, we are merely copying bytes to and from main storage,
1550 yet we need to keep track of varying record lengths. We adopt
1551 the solution used by f2c. Each record contains a pair of length
1554 Length of record n in bytes
1556 Length of record n in bytes
1558 Length of record n+1 in bytes
1560 Length of record n+1 in bytes
1562 The length is stored at the end of a record to allow backspacing to the
1563 previous record. Between data transfer statements, the file pointer
1564 is left pointing to the first length of the current record.
1566 ENDFILE records are never explicitly stored.